;;; dired.el --- directory-browsing commands
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
+;; Keywords: files
;; This file is part of GNU Emacs.
:group 'environment)
(defgroup dired-mark nil
- "Handling marks in dired."
+ "Handling marks in Dired."
:prefix "dired-"
:group 'dired)
(goto-char (point-min))
(when (re-search-forward "total [0-9]+$" nil t)
(insert " free ")
- (let ((beg (point)))
- (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))))
- ;; The dired-free-space-program failed; delete its output
- (delete-region (- beg 7) (point))))))))
+ ;; Non-Posix systems don't always have dired-free-space-program,
+ ;; but might have an equivalent system call.
+ (if (fboundp 'file-system-info)
+ (let ((beg (point))
+ (fsinfo (file-system-info dir-or-list)))
+ (if fsinfo
+ (insert
+ (format "%.0f" (/ (nth 2 fsinfo) 1024)))
+ ;; file-system-info failed; delete " free ".
+ (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))))
+ ;; The dired-free-space-program failed; delete its output
+ (delete-region (- beg 7) (point)))
+ (error (delete-region (- beg 7) (point))))))))))
;; Quote certain characters, unless ls quoted them for us.
(if (not (string-match "b" dired-actual-switches))
(save-excursion
(while (< (point) end)
(condition-case nil
(if (dired-move-to-filename)
- (put-text-property (point)
- (save-excursion
- (dired-move-to-end-of-filename)
- (point))
- 'mouse-face 'highlight))
+ (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))))
(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 "w" 'dired-show-file-type)
(define-key map "\C-m" 'dired-advertised-find-file)
(define-key map "g" 'revert-buffer)
(define-key map "h" 'describe-mode)
(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)
;; moving
(define-key map "<" 'dired-prev-dirline)
(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
+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,
parse the buffer again."
(interactive)
(let (buffer-read-only)
- (undo)))
+ (undo)
+ (message "Change in Dired buffer undone.
+Actual changes in files cannot be undone by Emacs.")))
(defun dired-next-line (arg)
"Move down lines then position at filename.
(dired-next-dirline (- arg)))
(defun dired-up-directory (&optional other-window)
- "Run dired on parent directory of current directory.
+ "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")
(dired up))
(dired-goto-file dir)))))
-;; Force `f' rather than `e' in the mode doc:
-(defalias 'dired-advertised-find-file 'dired-find-file)
-(defun dired-find-file ()
- "In dired, visit the file or directory named on this line."
+(defun dired-get-file-for-visit ()
+ "Get the current line's file name, with an error if file does not exist."
(interactive)
(let ((file-name (file-name-sans-versions (dired-get-filename) t)))
(if (file-exists-p file-name)
- (find-file file-name)
+ file-name
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
(error "File no longer exists; type `g' to update Dired buffer")))))
+;; Force `f' rather than `e' in the mode doc:
+(defalias 'dired-advertised-find-file 'dired-find-file)
+(defun dired-find-file ()
+ "In Dired, visit the file or directory named on this line."
+ (interactive)
+ (find-file (dired-get-file-for-visit)))
+
(defun dired-find-alternate-file ()
- "In dired, visit this file or directory instead of the dired buffer."
+ "In Dired, visit this file or directory instead of the dired buffer."
(interactive)
(set-buffer-modified-p nil)
- (find-alternate-file (dired-get-filename)))
+ (find-alternate-file (dired-get-file-for-visit)))
(defun dired-mouse-find-file-other-window (event)
- "In dired, visit the file or directory name you click on."
+ "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))))
+ (setq file (dired-get-file-for-visit))))
(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.
+ "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))))
+ (let ((file (dired-get-file-for-visit)))
+ (if (file-directory-p file)
+ (or (and (cdr dired-subdir-alist)
+ (dired-goto-subdir file))
+ (dired file))
+ (view-file file))))
(defun dired-find-file-other-window ()
- "In dired, visit this file or directory in another window."
+ "In Dired, visit this file or directory in another window."
(interactive)
- (find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
+ (find-file-other-window (dired-get-file-for-visit)))
(defun dired-display-file ()
- "In dired, display this file or directory in another window."
+ "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))))
+ (display-buffer (find-file-noselect (dired-get-file-for-visit))))
\f
-;;; Functions for extracting and manipulating file names in dired buffers.
+;;; Functions for extracting and manipulating file names in Dired buffers.
(defun dired-get-filename (&optional localp no-error-if-not-filep)
- "In dired, return name of file mentioned on this line.
+ "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 t means construct name relative to
+ 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."
file)
"\"")))))
(and file (file-name-absolute-p file)
+ ;; A relative file name can start with ~.
+ ;; Don't treat it as absolute in this context.
+ (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))
(defvar dired-move-to-filename-regexp
(let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
;; In some locales, month abbreviations are as short as 2 letters,
- ;; and they can be padded on the right with spaces.
- ;; weiand: changed: month ends potentially with . or , or .,
-;;old (month (concat l l "+ *"))
- (month (concat l l "+[.]?,? *"))
- ;; Recognize any non-ASCII character.
- ;; The purpose is to match a Kanji character.
- (k "[^\0-\177]")
- ;; (k "[^\x00-\x7f\x80-\xff]")
+ ;; and they can be followed by ".".
+ (month (concat l l "+\\.?"))
(s " ")
(yyyy "[0-9][0-9][0-9][0-9]")
- (mm "[ 0-1][0-9]")
-;;old (dd "[ 0-3][0-9]")
- (dd "[ 0-3][0-9][.]?")
+ (dd "[ 0-3][0-9]")
(HH:MM "[ 0-2][0-9]:[0-5][0-9]")
- (western (concat "\\(" month s dd "\\|" dd s month "\\)"
- ;; weiand: changed: year potentially unaligned
-;;old s "\\(" HH:MM "\\|" s yyyy "\\|" yyyy s "\\)"))
- s "\\(" HH:MM
- "\\|" yyyy s s "?"
- "\\|" s "?" yyyy
- "\\)"))
- (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
+ (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 "\\)"))
+ (western-comma (concat month s "+" dd "," s "+" yyyy))
+ ;; Japanese MS-Windows ls-lisp has one-digit months, and
+ ;; omits the Kanji characters after month and day-of-month.
+ (mm "[ 0-1]?[0-9]")
+ (japanese
+ (concat mm l "?" s dd l "?" s "+"
+ "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
;; The "[0-9]" below requires the previous column to end in a digit.
;; This avoids recognizing `1 may 1997' as a date in the line:
;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
+ ;; The "[kMGTPEZY]?" below supports "ls -alh" output.
;; The ".*" below finds the last match if there are multiple matches.
;; This avoids recognizing `jservice 10 1024' as a date in the line:
;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
- (concat ".*[0-9]" s "\\(" western "\\|" japanese "\\)" s))
+ (concat ".*[0-9][kMGTPEZY]?" s
+ "\\(" western "\\|" western-comma "\\|" 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.")
nil ; return nil if not found
(error "%s directory" (if (> arg 0) "Last" "First"))))))
-(defun dired-build-subdir-alist ()
+(defun dired-build-subdir-alist (&optional switches)
"Build `dired-subdir-alist' by parsing the buffer.
-Returns the new value of the alist."
+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)
- new-dir-name
- (R-ftp-base-dir-regex
- ;; Used to expand subdirectory names correctly in recursive
- ;; ange-ftp listings.
- (and (string-match "R" dired-actual-switches)
- (string-match "\\`/.*:\\(/.*\\)" default-directory)
- (concat "\\`" (match-string 1 default-directory)))))
+ (let* ((count 0)
+ (buffer-read-only nil)
+ (switches (or switches dired-actual-switches))
+ new-dir-name
+ (R-ftp-base-dir-regex
+ ;; Used to expand subdirectory names correctly in recursive
+ ;; ange-ftp listings.
+ (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)
(delete-directory file))))
(defun dired-do-flagged-delete (&optional nomessage)
- "In dired, delete the files flagged for deletion.
+ "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)
`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."
+ "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)
- (save-excursion
- (set-buffer (get-buffer-create bufname))
+ (with-current-buffer (get-buffer-create bufname)
(erase-buffer)
(dired-format-columns-of-files files)
- (remove-text-properties (point-min) (point-max) '(mouse-face)))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil)))
(save-window-excursion
(dired-pop-to-buffer bufname)
(apply function args))))
;; Point must be at beginning of line
;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
- (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard\\|^. used")
+ (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard\\|^. used\\|^. find")
(and (looking-at dired-subdir-regexp)
(save-excursion (not (dired-move-to-filename))))))
(dired-mark arg)))
(defun dired-flag-file-deletion (arg)
- "In dired, flag the current line's file for deletion.
+ "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 `..'."
(dired-mark arg)))
(defun dired-unmark-backward (arg)
- "In dired, move up lines and remove deletion flag there.
+ "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)))
"matching file")))
(defun dired-flag-files-regexp (regexp)
- "In dired, flag all files containing the specified REGEXP for deletion.
+ "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."
(dired-sort-set-modeline)
(revert-buffer))
+;; Some user code loads dired especially for this.
(defun dired-replace-in-string (regexp newtext string)
;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
(autoload 'dired-diff "dired-aux"
"Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark.
+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)