;;; dired.el --- directory-browsing commands
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001, 2003
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001, 03, 2004
;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
(defgroup dired nil
"Directory editing."
+ :link '(custom-manual "(emacs)Dired")
:group 'files)
(defgroup dired-mark nil
;; 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.
+;; Fixme: This should use mailcap.
(defcustom dired-view-command-alist
'(("[.]\\(ps\\|ps_pages\\|eps\\)\\'" . "gv -spartan -color -watch %s")
("[.]pdf\\'" . "xpdf %s")
;;; "\\([-d]\\(....w....\\|.......w.\\)\\)")
;;; '(1 font-lock-comment-face)
;;; '(".+" (dired-move-to-filename) nil (0 font-lock-comment-face)))
+ ;; However, we don't need to highlight the file name, only the
+ ;; permissions, to win generally. -- fx.
+ ;; Fixme: we could also put text properties on the permission
+ ;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
+ (list (concat dired-re-maybe-mark dired-re-inode-size
+ "[-d]....\\(w\\)..\\(w\\).") ; group writable
+ '(1 font-lock-warning-face))
+ (list (concat dired-re-maybe-mark dired-re-inode-size
+ "[-d]....\\(w\\)....") ; world writable
+ '(1 font-lock-comment-face))
;;
;; Subdirectories.
(list dired-re-dir
\f
;;; 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)
+ "Mark all files for which PREDICATE evals to non-nil.
+PREDICATE 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."
`(let (buffer-read-only count)
(save-excursion
(setq count 0)
(setq dir-or-list dirname))
(dired-internal-noselect dir-or-list switches)))
+;; The following is an internal dired function. It returns non-nil if
+;; the directory visited by the current dired buffer has changed on
+;; disk. DIRNAME should be the directory name of that directory.
+(defun dired-directory-changed-p (dirname)
+ (not (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)))))))
+
+(defun dired-buffer-stale-p (&optional noconfirm)
+ "Return non-nil if current dired buffer needs updating.
+If NOCONFIRM is non-nil, then this function always returns nil
+for a remote directory. This feature is used by Auto Revert Mode."
+ (let ((dirname
+ (if (consp dired-directory) (car dired-directory) dired-directory)))
+ (and (stringp dirname)
+ (not (when noconfirm (file-remote-p dirname)))
+ (file-readable-p dirname)
+ (dired-directory-changed-p dirname))))
+
;; Separate function from dired-noselect for the sake of dired-vms.el.
(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; 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.
+ ;; 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.
;; kill-all-local-variables any longer.
(setq buffer (create-file-buffer (directory-file-name dirname)))))
(set-buffer buffer)
- (if (not new-buffer-p) ; existing buffer ...
- (cond (switches ; ... but new switches
+ (if (not new-buffer-p) ; existing buffer ...
+ (cond (switches ; ... but new switches
;; file list may have changed
(setq dired-directory dir-or-list)
;; this calls dired-revert
(dired-sort-other switches))
;; 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
+ ((when (dired-directory-changed-p dirname)
(message "%s"
(substitute-command-keys
"Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
\f
;; 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 ()
+ "Read in a new dired buffer.
+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)."
+
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
(let (dirname)
;; based on dired-directory, e.g. with ange-ftp to a SysV host
;; where ls won't understand -Al switches.
(run-hooks 'dired-before-readin-hook)
- (message "Reading directory %s..." dirname)
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(let (buffer-read-only
(widen)
(erase-buffer)
(dired-readin-insert))
- (message "Reading directory %s...done" dirname)
(goto-char (point-min))
;; Must first make alist buffer local and set it to nil because
;; dired-build-subdir-alist will call dired-clear-alist first
;; Make the file names highlight when the mouse is on them.
(defun dired-insert-set-properties (beg end)
+ "Make the file names highlight when the mouse is on them."
(save-excursion
(goto-char beg)
(while (< (point) end)
;; 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.
+ "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 nil t))
(goto-char opoint)) ; was before
(dired-move-to-filename)
(save-excursion ; hide subdirs that were hidden
- (mapcar (function (lambda (dir)
- (if (dired-goto-subdir dir)
- (dired-hide-subdir 1))))
- hidden-subdirs)))
+ (dolist (dir hidden-subdirs)
+ (if (dired-goto-subdir dir)
+ (dired-hide-subdir 1)))))
;; outside of the let scope
;;; Might as well not override the user if the user changed this.
;;; (setq buffer-read-only t)
;; Some of these are also used when inserting subdirs.
(defun dired-remember-marks (beg end)
- ;; Return alist of files and their marks, from BEG to END.
+ "Return alist of files and their marks, from BEG to END."
(if selective-display ; must unhide to make this work.
(let (buffer-read-only)
(subst-char-in-region beg end ?\r ?\n)))
alist (cons (cons fil chr) alist)))))
alist))
-;; Mark all files remembered in ALIST.
-;; Each element of ALIST looks like (FILE . MARKERCHAR).
(defun dired-mark-remembered (alist)
+ "Mark all files remembered in ALIST.
+Each element of ALIST looks like (FILE . MARKERCHAR)."
(let (elt fil chr)
(while alist
(setq elt (car alist)
(delete-char 1)
(insert chr))))))
-;; Return a list of names of subdirs currently hidden.
(defun dired-remember-hidden ()
+ "Return a list of names of subdirs currently hidden."
(let ((l dired-subdir-alist) dir pos result)
(while l
(setq dir (car (car l))
(setq result (cons dir result))))
result))
-;; Try to insert all subdirs that were displayed before,
-;; according to the former subdir alist OLD-SUBDIR-ALIST.
(defun dired-insert-old-subdirs (old-subdir-alist)
+ "Try to insert all subdirs that were displayed before.
+Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(or (string-match "R" dired-actual-switches)
(let (elt dir)
(while old-subdir-alist
(dired-insert-subdir dir))
(error nil))))))
-;; Remove directory DIR from any directory cache.
(defun dired-uncache (dir)
+ "Remove directory DIR from any directory cache."
(let ((handler (find-file-name-handler dir 'dired-uncache)))
(if handler
(funcall handler 'dired-uncache dir))))
\f
;; dired mode key bindings and initialization
-(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
-(if dired-mode-map
- nil
+(defvar dired-mode-map
;; This looks ugly when substitute-command-keys uses C-d instead d:
;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
-
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map [mouse-2] 'dired-mouse-find-file-other-window)
(define-key map "*u" 'dired-unmark)
(define-key map "*?" 'dired-unmark-all-files)
(define-key map "*!" 'dired-unmark-all-marks)
+ (define-key map "U" '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)
'(menu-item "Copy to..." dired-do-copy
:help "Copy current file or all marked files"))
- (setq dired-mode-map map)))
+ map)
+ "Local keymap for `dired-mode' buffers.")
\f
;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)
+(defvar buffer-stale-function)
+
(defun dired-mode (&optional dirname switches)
"\
Mode for \"editing\" directory listings.
(propertized-buffer-identification "%17b"))
(set (make-local-variable 'revert-buffer-function)
(function dired-revert))
+ (set (make-local-variable 'buffer-stale-function)
+ (function dired-buffer-stale-p))
(set (make-local-variable 'page-delimiter)
"\n\n")
(set (make-local-variable 'dired-directory)
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))
+ (set (make-local-variable 'font-lock-defaults)
+ '(dired-font-lock-keywords t nil nil beginning-of-line))
(dired-sort-other dired-actual-switches t)
- (run-hooks 'dired-mode-hook))
+ (run-hooks 'dired-mode-hook)
+ (when (featurep 'x-dnd)
+ (make-variable-buffer-local 'x-dnd-test-function)
+ (make-variable-buffer-local 'x-dnd-protocol-alist)
+ (setq x-dnd-test-function 'dired-dnd-test-function)
+ (setq x-dnd-protocol-alist
+ (append '(("^file:///" . dired-dnd-handle-local-file)
+ ("^file://" . dired-dnd-handle-file)
+ ("^file:" . dired-dnd-handle-local-file))
+ x-dnd-protocol-alist))))
\f
;; Idiosyncratic dired commands that don't deal with marks.
(dired-move-to-filename)))
(defun dired-between-files ()
- ;; 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\\|^. find")
- (and (looking-at dired-subdir-regexp)
- (save-excursion (not (dired-move-to-filename))))))
+ ;; This used to be a regexp match of the `total ...' line output by
+ ;; ls, which is slightly faster, but that is not very robust; notably,
+ ;; it fails for non-english locales.
+ (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."
(file-name-nondirectory fn)))))
"auto save file")))
-(defvar dired-garbage-files-regexp
+(defcustom dired-garbage-files-regexp
+ ;; `log' here is dubious, ssince it's typically used for useful log
+ ;; files, not just TeX stuff. -- fx
(concat (regexp-opt
'(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux"))
"\\'")
- "*Regular expression to match \"garbage\" files for `dired-flag-garbage-files'.")
+ "Regular expression to match \"garbage\" files for `dired-flag-garbage-files'."
+ :type 'regexp
+ :group 'dired)
(defun dired-flag-garbage-files ()
"Flag for deletion all files that match `dired-garbage-files-regexp'."
;; So anything that does not contain these is sort "by name".
(defvar dired-ls-sorting-switches "SXU"
- "String of `ls' switches (single letters) except `t' that influence sorting.")
+ "String of `ls' switches \(single letters\) except `t' that influence sorting.
+
+This indicates to Dired which option switches to watch out for because they
+will change the sorting order behavior of `ls'.
+
+To change the default sorting order \(e.g. add a `-v' option\), see the
+variable `dired-listing-switches'. To temporarily override the listing
+format, use `\\[universal-argument] \\[dired]'.")
(defvar dired-sort-by-date-regexp
(concat "^-[^" dired-ls-sorting-switches
(autoload 'dired-run-shell-command "dired-aux")
(autoload 'dired-query "dired-aux")
+\f
+
+;;;; Drag and drop support
+
+(defun dired-dnd-test-function (window action types)
+ "The test function for drag and drop into dired buffers.
+WINDOW is where the mouse is when this function is called. It may be a frame
+if the mouse is over the menu bar, scroll bar or tool bar.
+ACTION is the suggested action from the source, and TYPES are the
+types the drop data can have. This function only accepts drops with
+types in `x-dnd-known-types'. It returns the action suggested by the source."
+ (let ((type (x-dnd-choose-type types)))
+ (if type
+ (cons action type)
+ nil)))
+
+(defun dired-dnd-popup-notice ()
+ (x-popup-dialog
+ t
+ '("Recursive copies not enabled.\nSee variable dired-recursive-copies."
+ ("Ok" . nil))))
+
+
+(defun dired-dnd-do-ask-action (uri)
+ ;; No need to get actions and descriptions from the source,
+ ;; we only have three actions anyway.
+ (let ((action (x-popup-menu
+ t
+ (list "What action?"
+ (cons ""
+ '(("Copy here" . copy)
+ ("Move here" . move)
+ ("Link here" . link)
+ "--"
+ ("Cancel" . nil)))))))
+ (if action
+ (dired-dnd-handle-local-file uri action)
+ nil)))
+
+(defun dired-dnd-handle-local-file (uri action)
+ "Copy, move or link a file to the dired directory.
+URI is the file to handle, ACTION is one of copy, move, link or ask.
+Ask means pop up a menu for the user to select one of copy, move or link."
+ (require 'dired-aux)
+ (let* ((from (x-dnd-get-local-file-name uri t))
+ (to (if from (concat (dired-current-directory)
+ (file-name-nondirectory from))
+ nil)))
+ (if from
+ (cond ((or (eq action 'copy)
+ (eq action 'private)) ; Treat private as copy.
+
+ ;; If copying a directory and dired-recursive-copies is nil,
+ ;; dired-copy-file silently fails. Pop up a notice.
+ (if (and (file-directory-p from)
+ (not dired-recursive-copies))
+ (dired-dnd-popup-notice)
+ (progn
+ (dired-copy-file from to 1)
+ (dired-relist-entry to)
+ action)))
+
+ ((eq action 'move)
+ (dired-rename-file from to 1)
+ (dired-relist-entry to)
+ action)
+
+ ((eq action 'link)
+ (make-symbolic-link from to 1)
+ (dired-relist-entry to)
+ action)
+
+ ((eq action 'ask)
+ (dired-dnd-do-ask-action uri))
+
+ (t nil)))))
+
+(defun dired-dnd-handle-file (uri action)
+ "Copy, move or link a file to the dired directory if it is a local file.
+URI is the file to handle. If the hostname in the URI isn't local, do nothing.
+ACTION is one of copy, move, link or ask.
+Ask means pop up a menu for the user to select one of copy, move or link."
+ (let ((local-file (x-dnd-get-local-file-uri uri)))
+ (if local-file (dired-dnd-handle-local-file local-file action)
+ nil)))
+
+
\f
(if (eq system-type 'vax-vms)
(load "dired-vms"))