;;; 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 silicon-graphics-unix))
+ (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
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
- (if (and (equal default-directory dirname)
+ ;; Expand before comparing in case one or both have been abbreviated.
+ (if (and (equal (expand-file-name default-directory)
+ (expand-file-name dirname))
(not (consp dir-or-list)))
;; If we are reading a whole single directory...
(dired-insert-directory dir-or-list dired-actual-switches nil t)
(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)
(define-key dired-mode-map "\C-_" 'dired-undo)
(define-key dired-mode-map "\C-xu" 'dired-undo)
)
-
-(or (member '(dired-sort-mode dired-sort-mode) minor-mode-alist)
- ;; Test whether this has already been done in case dired is reloaded
- ;; There may be several elements with dired-sort-mode as car.
- (setq minor-mode-alist
- (cons '(dired-sort-mode dired-sort-mode)
- ;; dired-sort-mode is nil outside dired
- minor-mode-alist)))
\f
;; Make menu bar items.
(dired-advertise) ; default-directory is already set
(setq major-mode 'dired-mode
mode-name "Dired"
- case-fold-search nil
+;; case-fold-search nil
buffer-read-only t
selective-display t ; for subdirectory hiding
mode-line-buffer-identification '("Dired: %17b"))
dired-directory)
(set (make-local-variable 'dired-actual-switches)
(or switches dired-listing-switches))
- (make-local-variable 'dired-sort-mode)
(dired-sort-other dired-actual-switches t)
(run-hooks 'dired-mode-hook))
\f
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.
;; DIR must be file-name-as-directory, as with all directory args in
;; Emacs Lisp code.
(or dir (setq dir default-directory))
+ ;; This case comes into play if default-directory is set to
+ ;; use ~.
+ (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))
(if no-error
\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.
(interactive)
(dired-clear-alist)
(save-excursion
- (let ((count 0))
+ (let ((count 0)
+ (buffer-read-only nil)
+ 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
+ (expand-file-name (buffer-substring (point) (match-end 1))))
+ (delete-region (point) (match-end 1))
+ (insert new-dir-name))
(setq count (1+ count))
- (dired-alist-add-1 (buffer-substring (match-beginning 1)
- (match-end 1))
- ;; Put subdir boundary between lines:
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (point-marker))))
+ (dired-alist-add-1 new-dir-name
+ ;; Place a sub directory boundary between lines.
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (point-marker))))
(if (> count 1)
(message "Buffer includes %d directories" count))
;; We don't need to sort it because it is in buffer order per
(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."
(concat "^-[^t" dired-ls-sorting-switches "]+$")
"Regexp recognized by dired to set `by name' mode.")
-(defvar dired-sort-mode nil
- "Whether Dired sorts by name, date etc. (buffer-local).")
-;; This is nil outside dired buffers so it can be used in the modeline
-
(defun dired-sort-set-modeline ()
;; Set modeline display according to dired-actual-switches.
;; Modeline display of "by name" or "by date" guarantees the user a
;; match with the corresponding regexps. Non-matching switches are
;; shown literally.
- (setq dired-sort-mode
+ (setq mode-name
(let (case-fold-search)
(cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
- " by name")
+ "Dired by name")
((string-match dired-sort-by-date-regexp dired-actual-switches)
- " by date")
+ "Dired by date")
(t
- (concat " " dired-actual-switches)))))
+ (concat "Dired " dired-actual-switches)))))
;; update mode line:
(set-buffer-modified-p (buffer-modified-p)))
(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)
(if (eq system-type 'vax-vms)
(load "dired-vms"))
-(run-hooks 'dired-load-hook) ; for your customizations
-
(provide 'dired)
+(run-hooks 'dired-load-hook) ; for your customizations
+
;;; dired.el ends here
HCoop / bpt / emacs.git / blobdiff