;;; dired.el --- directory-browsing commands
-;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Version: 6
+;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
(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'.")
+may contain even `F', `b', `i' and `s'. See also the variable
+`dired-ls-F-marks-symlinks' concerning the `F' switch.")
; 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
;;;###autoload
(defvar dired-chown-program
- (if (memq system-type '(hpux dgux usg-unix-v irix))
+ (if (memq system-type '(hpux dgux usg-unix-v irix linux))
"chown" "/etc/chown")
"Name of chown command (usually `chown' or `/etc/chown').")
"-[-r][-w].[-r][-w][xs][-r][-w]."
"-[-r][-w].[-r][-w].[-r][-w][xst]")
"\\|"))
+(defvar dired-re-perms "-[-r][-w].[-r][-w].[-r][-w].")
(defvar dired-re-dot "^.* \\.\\.?$")
(defvar dired-subdir-alist nil
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]"
+(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
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
- (setq dirname (expand-file-name (directory-file-name dirname)))
+ (setq dirname (abbreviate-file-name
+ (expand-file-name (directory-file-name dirname))))
(if (file-directory-p dirname)
(setq dirname (file-name-as-directory dirname)))
(if (consp dir-or-list)
(set-buffer buffer)
(if (not new-buffer-p) ; existing buffer ...
(if switches ; ... but new switches
- (dired-sort-other switches)) ; this calls dired-revert
+ (dired-sort-other switches) ; this calls dired-revert
+ ;; If directory has changed on disk, offer to revert.
+ (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 "Directory has changed on disk; type `g' to update Dired")))
;; Else a new buffer
- (setq default-directory (if (file-directory-p dirname)
- dirname
- (file-name-directory dirname)))
+ (setq default-directory
+ (if (file-directory-p dirname)
+ 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
;; 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)
- (dired-build-subdir-alist))))
+ (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))))
;; Subroutines of dired-readin
(defun dired-insert-directory (dir-or-list switches &optional wildcard full-p)
;; Do the right thing whether dir-or-list is atomic or not. If it is,
;; inset all files listed in the cdr (the car is the passed-in directory
- ;; list.
- (if (consp dir-or-list)
- (progn
- (mapcar
- (function (lambda (x) (insert-directory x switches wildcard full-p)))
- (cdr dir-or-list)))
- (insert-directory dir-or-list switches wildcard full-p))
+ ;; list).
+ (let ((opoint (point)))
+ (if (consp dir-or-list)
+ (progn
+ (mapcar
+ (function (lambda (x) (insert-directory x switches wildcard full-p)))
+ (cdr dir-or-list)))
+ (insert-directory dir-or-list switches wildcard full-p))
+ (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)
+ (if (dired-move-to-filename)
+ (put-text-property (point)
+ (save-excursion
+ (dired-move-to-end-of-filename)
+ (point))
+ 'mouse-face 'highlight))
+ (forward-line 1))))
+
(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
;; Remove directory DIR from any directory cache.
(defun dired-uncache (dir)
- (let ((handler (find-file-name-handler dir)))
+ (let ((handler (find-file-name-handler dir 'dired-uncache)))
(if handler
(funcall handler 'dired-uncache dir))))
\f
(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
(if dired-mode-map
nil
- ;; Force `f' rather than `e' in the mode doc:
- (defalias 'dired-advertised-find-file 'dired-find-file)
;; This looks ugly when substitute-command-keys uses C-d instead d:
;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
(setq dired-mode-map (make-keymap))
(suppress-keymap dired-mode-map)
+ (define-key dired-mode-map [mouse-2] 'dired-mouse-find-file-other-window)
;; Commands to mark or flag certain categories of files
(define-key dired-mode-map "#" 'dired-flag-auto-save-files)
(define-key dired-mode-map "*" 'dired-mark-executables)
(define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
(define-key dired-mode-map "\M-}" 'dired-next-marked-file)
;; Make all regexp commands share a `%' prefix:
- (defalias 'dired-regexp-prefix (make-sparse-keymap))
- (define-key dired-mode-map "%" 'dired-regexp-prefix)
+ ;; We used to get to the submap via a symbol dired-regexp-prefix,
+ ;; but that seems to serve little purpose, and copy-keymap
+ ;; does a better job without it.
+ (define-key dired-mode-map "%" nil)
(define-key dired-mode-map "%u" 'dired-upcase)
(define-key dired-mode-map "%l" 'dired-downcase)
(define-key dired-mode-map "%d" 'dired-flag-files-regexp)
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."
(interactive)
(find-file (file-name-sans-versions (dired-get-filename) t)))
+(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;
(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))))
;; nil if no file on this line, but no-error-if-not-filep is t:
- (if (setq file (and p1 p2 (buffer-substring p1 p2)))
+ (if (setq file (and p1 p2 (format "%s" (buffer-substring p1 p2))))
;; Check if ls quoted the names, and unquote them.
;; Using read to unquote is much faster than substituting
;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
\f
;;; Functions for finding the file name in a dired buffer line.
+(defvar dired-move-to-filename-regexp
+ "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] "
+ "Regular expression to match a month abbreviation followed by a number.")
+
;; Move to first char of filename on this line.
;; Returns position (point) or nil if no filename on this line."
(defun dired-move-to-filename (&optional raise-error eol)
;; This is the UNIX version.
(or eol (setq eol (progn (end-of-line) (point))))
(beginning-of-line)
- (if (re-search-forward
- "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
- eol t)
- (progn
- (skip-chars-forward " ") ; there is one SPC after day of month
- (skip-chars-forward "^ " eol) ; move after time of day (or year)
- (skip-chars-forward " " eol) ; there is space before the file name
- ;; Actually, if the year instead of clock time is displayed,
- ;; there are (only for some ls programs?) two spaces instead
- ;; of one before the name.
- ;; If we could depend on ls inserting exactly one SPC we
- ;; would not bomb on names _starting_ with SPC.
- (point))
+ (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")
- nil)))
+ (error "No file on this line"))))
(defun dired-move-to-end-of-filename (&optional no-error)
;; Assumes point is at beginning of filename,
(defun dired-in-this-tree (file dir)
;;"Is FILE part of the directory tree starting at DIR?"
(let (case-fold-search)
- (string-match (concat "^" (regexp-quote dir)) file)))
+ (string-match (concat "^" (regexp-quote (expand-file-name dir))) file)))
(defun dired-normalize-subdir (dir)
;; Prepend default-directory to DIR if relative path name.
new-dir-name)
(goto-char (point-min))
(setq dired-subdir-alist nil)
- (while (re-search-forward dired-subdir-regexp nil t)
+ (while (and (re-search-forward dired-subdir-regexp nil t)
+ ;; Avoid taking a file name ending in a colon
+ ;; as a subdir name.
+ (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
(save-excursion
;; The hair here is to get the result of dired-goto-subdir
;; without really calling it if we don't have any subdirs.
- (if (if (string= dir default-directory)
+ (if (if (string= dir (expand-file-name default-directory))
(goto-char (point-min))
(and (cdr dired-subdir-alist)
(dired-goto-subdir dir)))
;; correct) match could have been elsewhere on the
;; ;; line (e.g. "-" would match somewhere in the
;; permission bits).
- (setq found (dired-move-to-filename)))))))
+ (setq found (dired-move-to-filename))
+ ;; If this isn't the right line, move forward to avoid
+ ;; trying this line again.
+ (forward-line 1))))))
(and found
;; return value of point (i.e., FOUND):
(goto-char found))))
(save-excursion
(set-buffer (get-buffer-create bufname))
(erase-buffer)
- (dired-format-columns-of-files files))
+ (dired-format-columns-of-files files)
+ (remove-text-properties (point-min) (point-max) '(mouse-face)))
(save-window-excursion
(dired-pop-to-buffer bufname)
(apply function args))))
;; 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")
- (looking-at dired-subdir-regexp)))
+ (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."
(let (case-fold-search)
(concat
"-l"
- (dired-replace-in-string (concat "[---lt"
+ (dired-replace-in-string (concat "[-lt"
dired-ls-sorting-switches "]")
""
dired-actual-switches)
HCoop / bpt / emacs.git / blobdiff