dired.el 162 KB
Newer Older
1
;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
2

3
;; Copyright (C) 1985-1986, 1992-1997, 2000-2011
Glenn Morris's avatar
Glenn Morris committed
4
;;   Free Software Foundation, Inc.
5

6 7
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
Gerd Moellmann's avatar
Gerd Moellmann committed
8
;; Keywords: files
9
;; Package: emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
10 11 12

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Eric S. Raymond's avatar
Eric S. Raymond committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
25

26 27
;;; Commentary:

28 29
;; This is a major mode for directory browsing and editing.
;; It is documented in the Emacs manual.
30

31 32 33 34
;; Rewritten in 1990/1991 to add tree features, file marking and
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.

35
;;; Code:
36

Stefan Monnier's avatar
Stefan Monnier committed
37 38
(eval-when-compile (require 'cl))

39 40
;;; Customizable variables

41 42
(defgroup dired nil
  "Directory editing."
43
  :link '(custom-manual "(emacs)Dired")
44
  :group 'files)
45 46

(defgroup dired-mark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
47
  "Handling marks in Dired."
48 49 50 51
  :prefix "dired-"
  :group 'dired)


Eric S. Raymond's avatar
Eric S. Raymond committed
52
;;;###autoload
53
(defcustom dired-listing-switches (purecopy "-al")
Lute Kamstra's avatar
Lute Kamstra committed
54
  "Switches passed to `ls' for Dired.  MUST contain the `l' option.
55
May contain all other options that don't contradict `-l';
56
may contain even `F', `b', `i' and `s'.  See also the variable
57 58 59
`dired-ls-F-marks-symlinks' concerning the `F' switch.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
some of the `ls' switches are not supported; see the doc string of
60
`insert-directory' in `ls-lisp.el' for more details."
61 62
  :type 'string
  :group 'dired)
Eric S. Raymond's avatar
Eric S. Raymond committed
63

64
(defcustom dired-subdir-switches nil
65
  "If non-nil, switches passed to `ls' for inserting subdirectories.
66 67 68 69
If nil, `dired-listing-switches' is used."
   :group 'dired
   :type '(choice (const :tag "Use dired-listing-switches" nil)
                  (string :tag "Switches")))
70

71 72 73 74 75 76 77 78 79 80
(defcustom dired-chown-program
  (purecopy (cond ((executable-find "chown") "chown")
                  ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
                  ((file-executable-p "/etc/chown") "/etc/chown")
                  (t "chown")))
  "Name of chown command (usually `chown')."
  :group 'dired
  :type 'file)

(defcustom dired-use-ls-dired 'unspecified
81
  "Non-nil means Dired should pass the \"--dired\" option to \"ls\".
82 83
The special value of `unspecified' means to check explicitly, and
save the result in this variable.  This is performed the first
84 85 86 87 88 89 90 91 92 93 94 95 96
time `dired-insert-directory' is called.

Note that if you set this option to nil, either through choice or
because your \"ls\" program does not support \"--dired\", Dired
will fail to parse some \"unusual\" file names, e.g. those with leading
spaces.  You might want to install ls from GNU Coreutils, which does
support this option.  Alternatively, you might want to use Emacs's
own emulation of \"ls\", by using:
  \(setq ls-lisp-use-insert-directory-program nil)
  \(require 'ls-lisp)
This is used by default on MS Windows, which does not have an \"ls\" program.
Note that `ls-lisp' does not support as many options as GNU ls, though.
For more details, see Info node `(emacs)ls in Lisp'."
97 98 99 100 101 102 103 104 105 106 107 108 109 110
  :group 'dired
  :type '(choice (const :tag "Check for --dired support" unspecified)
                 (const :tag "Do not use --dired" nil)
                 (other :tag "Use --dired" t)))

(defcustom dired-chmod-program "chmod"
  "Name of chmod command (usually `chmod')."
  :group 'dired
  :type 'file)

(defcustom dired-touch-program "touch"
  "Name of touch command (usually `touch')."
   :group 'dired
   :type 'file)
111

112
(defcustom dired-ls-F-marks-symlinks nil
Lute Kamstra's avatar
Lute Kamstra committed
113
  "Informs Dired about how `ls -lF' marks symbolic links.
114 115
Set this to t if `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
116
itself with a trailing @ (usually the case under Ultrix).
Eric S. Raymond's avatar
Eric S. Raymond committed
117

118 119 120 121 122 123
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
124 125 126
always set this variable to t."
  :type 'boolean
  :group 'dired-mark)
127

128
(defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
Lute Kamstra's avatar
Lute Kamstra committed
129
  "Regexp of files to skip when finding first file of a directory.
130
A value of nil means move to the subdir line.
131 132 133 134 135
A value of t means move to first file."
  :type '(choice (const :tag "Move to subdir" nil)
		 (const :tag "Move to first" t)
		 regexp)
  :group 'dired)
136

137
(defcustom dired-keep-marker-rename t
138
  ;; Use t as default so that moved files "take their markers with them".
Lute Kamstra's avatar
Lute Kamstra committed
139
  "Controls marking of renamed files.
140 141
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
142 143 144 145
are afterward marked with that character."
  :type '(choice (const :tag "Keep" t)
		 (character :tag "Mark"))
  :group 'dired-mark)
146

147
(defcustom dired-keep-marker-copy ?C
Lute Kamstra's avatar
Lute Kamstra committed
148
  "Controls marking of copied files.
149
If t, copied files are marked if and as the corresponding original files were.
150 151 152 153
If a character, copied files are unconditionally marked with that character."
  :type '(choice (const :tag "Keep" t)
		 (character :tag "Mark"))
  :group 'dired-mark)
154

155
(defcustom dired-keep-marker-hardlink ?H
Lute Kamstra's avatar
Lute Kamstra committed
156
  "Controls marking of newly made hard links.
157
If t, they are marked if and as the files linked to were marked.
158 159 160 161
If a character, new links are unconditionally marked with that character."
  :type '(choice (const :tag "Keep" t)
		 (character :tag "Mark"))
  :group 'dired-mark)
162

163
(defcustom dired-keep-marker-symlink ?Y
Lute Kamstra's avatar
Lute Kamstra committed
164
  "Controls marking of newly made symbolic links.
165
If t, they are marked if and as the files linked to were marked.
166 167 168 169
If a character, new links are unconditionally marked with that character."
  :type '(choice (const :tag "Keep" t)
		 (character :tag "Mark"))
  :group 'dired-mark)
170

171
(defcustom dired-dwim-target nil
Lute Kamstra's avatar
Lute Kamstra committed
172
  "If non-nil, Dired tries to guess a default target directory.
173 174 175
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.

176 177 178
The target is used in the prompt for file copy, rename etc."
  :type 'boolean
  :group 'dired)
179

180
(defcustom dired-copy-preserve-time t
Lute Kamstra's avatar
Lute Kamstra committed
181
  "If non-nil, Dired preserves the last-modified time in a file copy.
182 183 184
\(This works on only some systems.)"
  :type 'boolean
  :group 'dired)
185

186 187 188 189 190
; These variables were deleted and the replacements are on files.el.
; We leave aliases behind for back-compatibility.
(defvaralias 'dired-free-space-program 'directory-free-space-program)
(defvaralias 'dired-free-space-args 'directory-free-space-args)

191 192
;;; Hook variables

193
(defcustom dired-load-hook nil
194
  "Run after loading Dired.
195 196 197
You can customize key bindings or load extensions with this."
  :group 'dired
  :type 'hook)
198

199
(defcustom dired-mode-hook nil
200
  "Run at the very end of `dired-mode'."
201 202
  :group 'dired
  :type 'hook)
203

204 205 206 207
(defcustom dired-before-readin-hook nil
  "This hook is run before a dired buffer is read in (created or reverted)."
  :group 'dired
  :type 'hook)
208

209
(defcustom dired-after-readin-hook nil
210 211
  "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
212 213 214
with the buffer narrowed to the listing."
  :group 'dired
  :type 'hook)
215 216 217
;; 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.

218 219 220 221 222 223
(defcustom dired-dnd-protocol-alist
  '(("^file:///" . dired-dnd-handle-local-file)
    ("^file://"  . dired-dnd-handle-file)
    ("^file:"    . dired-dnd-handle-local-file))
  "The functions to call when a drop in `dired-mode' is made.
See `dnd-protocol-alist' for more information.  When nil, behave
224
as in other buffers.  Changing this option is effective only for
225
new dired buffers."
226 227 228 229 230
  :type '(choice (repeat (cons (regexp) (function)))
		 (const :tag "Behave as in other buffers" nil))
  :version "22.1"
  :group 'dired)

231
;; Internal variables
232 233 234 235 236 237 238 239 240 241 242

(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.
243
This is what the do-commands look for, and what the mark-commands store.")
244 245 246 247

(defvar dired-del-marker ?D
  "Character used to flag files for deletion.")

248
(defvar dired-shrink-to-fit t
249 250
;; I see no reason ever to make this nil -- rms.
;;  (> baud-rate search-slow-speed)
251 252
  "Non-nil means Dired shrinks the display buffer to fit the marked files.")

253 254
(defvar dired-file-version-alist)

255
;;;###autoload
256
(defvar dired-directory nil
257
  "The directory name or wildcard spec that this dired directory lists.
258
Local to each dired buffer.  May be a list, in which case the car is the
259 260
directory name and the cdr is the list of files to mention.
The directory name must be absolute, but need not be fully expanded.")
261

262
;; Beware of "-l;reboot" etc.  See bug#3230.
263
(defun dired-safe-switches-p (switches)
264 265 266 267 268
  "Return non-nil if string SWITCHES does not look risky for dired."
  (or (not switches)
      (and (stringp switches)
           (< (length switches) 100)    ; arbitrary
           (string-match "\\` *-[- [:alnum:]]+\\'" switches))))
269

270 271 272
(defvar dired-actual-switches nil
  "The value of `dired-listing-switches' used to make this buffer's text.")

273 274
(put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p)

275 276 277 278 279 280 281 282 283 284 285
(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 "^. ")
286 287 288 289
;; The [^:] part after "d" and "l" is to avoid confusion with the
;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
(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[^:]"))
290 291 292 293 294 295 296 297
(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)))
	     '("-[-r][-w][xs][-r][-w].[-r][-w]."
	       "-[-r][-w].[-r][-w][xs][-r][-w]."
	       "-[-r][-w].[-r][-w].[-r][-w][xst]")
	     "\\|"))
298
(defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
299
(defvar dired-re-dot "^.* \\.\\.?/?$")
300

301
;; The subdirectory names in the next two lists are expanded.
302 303 304
(defvar dired-subdir-alist nil
  "Association list of subdirectories and their buffer positions.
Each subdirectory has an element: (DIRNAME . STARTMARKER).
Richard M. Stallman's avatar
Richard M. Stallman committed
305 306
The order of elements is the reverse of the order in the buffer.
In simple cases, this list contains one element.")
307

308 309 310 311 312
(defvar dired-switches-alist nil
  "Keeps track of which switches to use for inserted subdirectories.
This is an alist of the form (SUBDIR . SWITCHES).")
(make-variable-buffer-local 'dired-switches-alist)

313 314 315
(defvaralias 'dired-move-to-filename-regexp
  'directory-listing-before-filename-regexp)

316
(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
317 318 319 320 321 322
  "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.")

Juri Linkov's avatar
Juri Linkov committed
323
(defgroup dired-faces nil
324
  "Faces used by Dired."
Juri Linkov's avatar
Juri Linkov committed
325 326 327 328 329 330 331
  :group 'dired
  :group 'faces)

(defface dired-header
  '((t (:inherit font-lock-type-face)))
  "Face used for directory headers."
  :group 'dired-faces
332
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
333 334 335 336 337 338 339
(defvar dired-header-face 'dired-header
  "Face name used for directory headers.")

(defface dired-mark
  '((t (:inherit font-lock-constant-face)))
  "Face used for dired marks."
  :group 'dired-faces
340
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
341 342 343 344
(defvar dired-mark-face 'dired-mark
  "Face name used for dired marks.")

(defface dired-marked
345
  '((t (:inherit warning)))
Juri Linkov's avatar
Juri Linkov committed
346 347
  "Face used for marked files."
  :group 'dired-faces
348
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
349 350 351 352
(defvar dired-marked-face 'dired-marked
  "Face name used for marked files.")

(defface dired-flagged
353
  '((t (:inherit error)))
354
  "Face used for files flagged for deletion."
Juri Linkov's avatar
Juri Linkov committed
355
  :group 'dired-faces
356
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
357
(defvar dired-flagged-face 'dired-flagged
358
  "Face name used for files flagged for deletion.")
Juri Linkov's avatar
Juri Linkov committed
359 360

(defface dired-warning
361 362 363
  ;; Inherit from font-lock-warning-face since with min-colors 8
  ;; font-lock-comment-face is not colored any more.
  '((t (:inherit font-lock-warning-face)))
Juri Linkov's avatar
Juri Linkov committed
364 365
  "Face used to highlight a part of a buffer that needs user attention."
  :group 'dired-faces
366
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
367 368 369
(defvar dired-warning-face 'dired-warning
  "Face name used for a part of a buffer that needs user attention.")

370
(defface dired-perm-write
371
  '((((type w32 pc)) :inherit default)  ;; These default to rw-rw-rw.
372 373
    ;; Inherit from font-lock-comment-delimiter-face since with min-colors 8
    ;; font-lock-comment-face is not colored any more.
374
    (t (:inherit font-lock-comment-delimiter-face)))
375 376 377
  "Face used to highlight permissions of group- and world-writable files."
  :group 'dired-faces
  :version "22.2")
378
(defvar dired-perm-write-face 'dired-perm-write
379 380
  "Face name used for permissions of group- and world-writable files.")

Juri Linkov's avatar
Juri Linkov committed
381 382 383 384
(defface dired-directory
  '((t (:inherit font-lock-function-name-face)))
  "Face used for subdirectories."
  :group 'dired-faces
385
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
386 387 388 389 390 391 392
(defvar dired-directory-face 'dired-directory
  "Face name used for subdirectories.")

(defface dired-symlink
  '((t (:inherit font-lock-keyword-face)))
  "Face used for symbolic links."
  :group 'dired-faces
393
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
394 395 396 397
(defvar dired-symlink-face 'dired-symlink
  "Face name used for symbolic links.")

(defface dired-ignored
398
  '((t (:inherit shadow)))
Juri Linkov's avatar
Juri Linkov committed
399 400
  "Face used for files suffixed with `completion-ignored-extensions'."
  :group 'dired-faces
401
  :version "22.1")
Juri Linkov's avatar
Juri Linkov committed
402 403 404
(defvar dired-ignored-face 'dired-ignored
  "Face name used for files suffixed with `completion-ignored-extensions'.")

405 406
(defvar dired-font-lock-keywords
  (list
Juri Linkov's avatar
Juri Linkov committed
407 408 409
   ;;
   ;; Dired marks.
   (list dired-re-mark '(0 dired-mark-face))
410 411 412 413 414 415
   ;;
   ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
   ;; file name itself.  We search for Dired defined regexps, and then use the
   ;; Dired defined function `dired-move-to-filename' before searching for the
   ;; simple regexp ".+".  It is that regexp which matches the file name.
   ;;
Juri Linkov's avatar
Juri Linkov committed
416 417 418 419 420 421 422
   ;; Marked files.
   (list (concat "^[" (char-to-string dired-marker-char) "]")
         '(".+" (dired-move-to-filename) nil (0 dired-marked-face)))
   ;;
   ;; Flagged files.
   (list (concat "^[" (char-to-string dired-del-marker) "]")
         '(".+" (dired-move-to-filename) nil (0 dired-flagged-face)))
423 424 425 426 427 428 429 430
   ;; People who are paranoid about security would consider this more
   ;; important than other things such as whether it is a directory.
   ;; But we don't want to encourage paranoia, so our default
   ;; should be what's most useful for non-paranoids. -- rms.
;;;   ;;
;;;   ;; Files that are group or world writable.
;;;   (list (concat dired-re-maybe-mark dired-re-inode-size
;;;		 "\\([-d]\\(....w....\\|.......w.\\)\\)")
Juri Linkov's avatar
Juri Linkov committed
431 432
;;;	 '(1 dired-warning-face)
;;;	 '(".+" (dired-move-to-filename) nil (0 dired-warning-face)))
433 434 435 436 437
   ;; 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
438
		 "[-d]....\\(w\\)....")	; group writable
439
	 '(1 dired-perm-write-face))
440
   (list (concat dired-re-maybe-mark dired-re-inode-size
441
		 "[-d].......\\(w\\).")	; world writable
442
	 '(1 dired-perm-write-face))
443 444 445
   ;;
   ;; Subdirectories.
   (list dired-re-dir
Juri Linkov's avatar
Juri Linkov committed
446
	 '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
447 448
   ;;
   ;; Symbolic links.
Juanma Barranquero's avatar
Juanma Barranquero committed
449
   (list dired-re-sym
Juri Linkov's avatar
Juri Linkov committed
450
	 '(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
451 452 453
   ;;
   ;; Files suffixed with `completion-ignored-extensions'.
   '(eval .
454 455 456
     ;; It is quicker to first find just an extension, then go back to the
     ;; start of that file name.  So we do this complex MATCH-ANCHORED form.
     (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473
	   '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
   ;;
   ;; Files suffixed with `completion-ignored-extensions'
   ;; plus a character put in by -F.
   '(eval .
     (list (concat "\\(" (regexp-opt completion-ignored-extensions)
		   "\\|#\\)[*=|]$")
	   '(".+" (progn
		    (end-of-line)
		    ;; If the last character is not part of the filename,
		    ;; move back to the start of the filename
		    ;; so it can be fontified.
		    ;; Otherwise, leave point at the end of the line;
		    ;; that way, nothing is fontified.
		    (unless (get-text-property (1- (point)) 'mouse-face)
		      (dired-move-to-filename)))
	     nil (0 dired-ignored-face))))
474 475 476 477
   ;;
   ;; Explicitly put the default face on file names ending in a colon to
   ;; avoid fontifying them as directory header.
   (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
478
	 '(".+" (dired-move-to-filename) nil (0 'default)))
479 480 481
   ;;
   ;; Directory headers.
   (list dired-subdir-regexp '(1 dired-header-face))
482
)
483
  "Additional expressions to highlight in Dired mode.")
484 485

(defvar dnd-protocol-alist)
Dave Love's avatar
Dave Love committed
486

487 488 489
;;; Macros must be defined before they are used, for the byte compiler.

(defmacro dired-mark-if (predicate msg)
490 491 492 493 494
  "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."
495
  `(let ((inhibit-read-only t) count)
496 497
    (save-excursion
      (setq count 0)
498 499 500 501 502 503 504 505 506 507
      (when ,msg
	(message "%s %ss%s..."
		 (cond ((eq dired-marker-char ?\040) "Unmarking")
		       ((eq dired-del-marker dired-marker-char)
			"Flagging")
		       (t "Marking"))
		 ,msg
		 (if (eq dired-del-marker dired-marker-char)
		     " for deletion"
		   "")))
508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523
      (goto-char (point-min))
      (while (not (eobp))
        (if ,predicate
            (progn
              (delete-char 1)
              (insert dired-marker-char)
              (setq count (1+ count))))
        (forward-line 1))
      (if ,msg (message "%s %s%s %s%s."
                        count
                        ,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)))
524

525 526
(defmacro dired-map-over-marks (body arg &optional show-progress
				     distinguish-one-marked)
527
  "Eval BODY with point on each marked line.  Return a list of BODY's results.
528 529 530 531 532 533 534 535 536 537
If no marked file could be found, execute BODY on the current
line.  ARG, if non-nil, specifies the files to use instead of the
marked files.

If ARG is an integer, use the next ARG (or previous -ARG, if
ARG<0) 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.
For any other non-nil value of ARG, use the current file.

538
If optional third arg SHOW-PROGRESS evaluates to non-nil,
539 540 541 542 543 544 545 546 547 548
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.

549 550
BODY should not be too long as it is expanded four times.

551 552
If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one
marked file, return (t FILENAME) instead of (FILENAME)."
553 554 555 556 557
  ;;
  ;;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
558
       (let ((inhibit-read-only t) case-fold-search found results)
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589
	 (if ,arg
	     (if (integerp ,arg)
		 (progn	;; no save-excursion, want to move point.
		   (dired-repeat-over-lines
		    ,arg
		    (function (lambda ()
				(if ,show-progress (sit-for 0))
				(setq results (cons ,body results)))))
		   (if (< ,arg 0)
		       (nreverse results)
		     results))
	       ;; non-nil, non-integer ARG means use current file:
	       (list ,body))
	   (let ((regexp (dired-marker-regexp)) next-position)
	     (save-excursion
	       (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)
					(point-marker))
		     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)
590
		 (setq next-position (and (re-search-forward regexp nil t)
591
					  (point-marker)))))
592 593
	     (if (and ,distinguish-one-marked (= (length results) 1))
		 (setq results (cons t results)))
594 595 596 597 598
	     (if found
		 results
	       (list ,body)))))
     ;; save-excursion loses, again
     (dired-move-to-filename)))
599

600
(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
601 602 603
  "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.
604
Values returned are normally absolute file names.
605
Optional arg LOCALP as in `dired-get-filename'.
606 607 608 609 610
Optional second argument ARG, if non-nil, specifies files near
 point instead of marked files.  It usually comes from the prefix
 argument.
  If ARG is an integer, use the next ARG files.
  Any other non-nil value means to use the current file instead.
611
Optional third argument FILTER, if non-nil, is a function to select
612 613 614 615 616 617 618 619 620 621 622
  some of the files--those for which (funcall FILTER FILENAME) is non-nil.

If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
return (t FILENAME) instead of (FILENAME).
Don't use that together with FILTER."
  (let* ((all-of-them
	  (save-excursion
	    (dired-map-over-marks
	     (dired-get-filename localp)
	     arg nil distinguish-one-marked)))
	 result)
623
    (if (not filter)
624 625 626
	(if (and distinguish-one-marked (eq (car all-of-them) t))
	    all-of-them
	  (nreverse all-of-them))
627 628 629 630
      (dolist (file all-of-them)
	(if (funcall filter file)
	    (push file result)))
      result)))
Dave Love's avatar
Dave Love committed
631

632 633 634 635
;; The dired command

(defun dired-read-dir-and-switches (str)
  ;; For use in interactive.
636 637 638 639
  (reverse (list
	    (if current-prefix-arg
		(read-string "Dired listing switches: "
			     dired-listing-switches))
640 641 642 643 644 645
	    ;; If a dialog is used, call `read-directory-name' so the
	    ;; dialog code knows we want directories.  Some dialogs
	    ;; can only select directories or files when popped up,
	    ;; not both.  If no dialog is used, call `read-file-name'
	    ;; because the user may want completion of file names for
	    ;; use in a wildcard pattern.
646 647 648
	    (if (next-read-file-uses-dialog-p)
		(read-directory-name (format "Dired %s(directory): " str)
				     nil default-directory nil)
649 650
	      (read-file-name (format "Dired %s(directory): " str)
			      nil default-directory nil)))))
651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703

;; We want to switch to a more sophisticated version of
;; dired-read-dir-and-switches like the following, if there is a way
;; to make it more intuitive.  See bug#1285.

;; (defun dired-read-dir-and-switches (str)
;;   ;; For use in interactive.
;;   (reverse
;;    (list
;;     (if current-prefix-arg
;;         (read-string "Dired listing switches: "
;;                      dired-listing-switches))
;;     ;; If a dialog is about to be used, call read-directory-name so
;;     ;; the dialog code knows we want directories.  Some dialogs can
;;     ;; only select directories or files when popped up, not both.
;;     (if (next-read-file-uses-dialog-p)
;;         (read-directory-name (format "Dired %s(directory): " str)
;;                              nil default-directory nil)
;;       (let ((cie ()))
;;         (dolist (ext completion-ignored-extensions)
;;           (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
;;         (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
;;         (lexical-let* ((default (and buffer-file-name
;;                                      (abbreviate-file-name buffer-file-name)))
;;                        (cie cie)
;;                        (completion-table
;;                         ;; We need a mix of read-file-name and
;;                         ;; read-directory-name so that completion to directories
;;                         ;; is preferred, but if the user wants to enter a global
;;                         ;; pattern, he can still use completion on filenames to
;;                         ;; help him write the pattern.
;;                         ;; Essentially, we want to use
;;                         ;; (completion-table-with-predicate
;;                         ;;  'read-file-name-internal 'file-directory-p nil)
;;                         ;; but that doesn't work because read-file-name-internal
;;                         ;; does not obey its `predicate' argument.
;;                         (completion-table-in-turn
;;                          (lambda (str pred action)
;;                            (let ((read-file-name-predicate
;;                                   (lambda (f)
;;                                     (and (not (member f '("./" "../")))
;;                                          ;; Hack! Faster than file-directory-p!
;;                                          (eq (aref f (1- (length f))) ?/)
;;                                          (not (string-match cie f))))))
;;                              (complete-with-action
;;                               action 'read-file-name-internal str nil)))
;;                          'read-file-name-internal)))
;;           (minibuffer-with-setup-hook
;;               (lambda ()
;;                 (setq minibuffer-default default)
;;                 (setq minibuffer-completion-table completion-table))
;;             (read-file-name (format "Dired %s(directory): " str)
;;                             nil default-directory nil))))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
704

705 706 707 708 709 710 711 712 713
(defun dired-file-name-at-point ()
  "Try to get a file name at point in the current dired buffer.
This hook is inteneded to be put in `file-name-at-point-functions'."
  (let ((filename (dired-get-filename nil t)))
    (when filename
      (if (file-directory-p filename)
	  (file-name-as-directory (abbreviate-file-name filename))
	(abbreviate-file-name filename)))))

714
;;;###autoload (define-key ctl-x-map "d" 'dired)
Eric S. Raymond's avatar
Eric S. Raymond committed
715
;;;###autoload
716
(defun dired (dirname &optional switches)
Eric S. Raymond's avatar
Eric S. Raymond committed
717
  "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
718 719 720
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
721
shell wildcards appended to select certain files).  If DIRNAME is a cons,
Richard M. Stallman's avatar
Richard M. Stallman committed
722
its first element is taken as the directory name and the rest as an explicit
723
list of files to make directory entries for.
724
\\<dired-mode-map>\
725 726
You can flag files for deletion with \\[dired-flag-file-deletion] and then
delete them by typing \\[dired-do-flagged-delete].
727
Type \\[describe-mode] after entering Dired for more info.
Eric S. Raymond's avatar
Eric S. Raymond committed
728

729 730 731 732 733 734
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)
Eric S. Raymond's avatar
Eric S. Raymond committed
735
;;;###autoload
736
(defun dired-other-window (dirname &optional switches)
Eric S. Raymond's avatar
Eric S. Raymond committed
737
  "\"Edit\" directory DIRNAME.  Like `dired' but selects in another window."
738 739
  (interactive (dired-read-dir-and-switches "in other window "))
  (switch-to-buffer-other-window (dired-noselect dirname switches)))
Eric S. Raymond's avatar
Eric S. Raymond committed
740

741 742 743 744 745 746 747
;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
;;;###autoload
(defun dired-other-frame (dirname &optional switches)
  "\"Edit\" directory DIRNAME.  Like `dired' but makes a new frame."
  (interactive (dired-read-dir-and-switches "in other frame "))
  (switch-to-buffer-other-frame (dired-noselect dirname switches)))

Eric S. Raymond's avatar
Eric S. Raymond committed
748
;;;###autoload
749
(defun dired-noselect (dir-or-list &optional switches)
Eric S. Raymond's avatar
Eric S. Raymond committed
750
  "Like `dired' but returns the dired buffer as value, does not select it."
751
  (or dir-or-list (setq dir-or-list default-directory))
752 753
  ;; This loses the distinction between "/foo/*/" and "/foo/*" that
  ;; some shells make:
754
  (let (dirname initially-was-dirname)
755 756 757
    (if (consp dir-or-list)
	(setq dirname (car dir-or-list))
      (setq dirname dir-or-list))
758 759
    (setq initially-was-dirname
	  (string= (file-name-as-directory dirname) dirname))
760 761
    (setq dirname (abbreviate-file-name
		   (expand-file-name (directory-file-name dirname))))
762 763
    (if find-file-visit-truename
	(setq dirname (file-truename dirname)))
764 765 766 767 768 769 770 771
    ;; If the argument was syntactically  a directory name not a file name,
    ;; or if it happens to name a file that is a directory,
    ;; convert it syntactically to a directory name.
    ;; The reason for checking initially-was-dirname
    ;; and not just file-directory-p
    ;; is that file-directory-p is slow over ftp.
    (if (or initially-was-dirname (file-directory-p dirname))
	(setq dirname  (file-name-as-directory dirname)))
772 773 774 775
    (if (consp dir-or-list)
	(setq dir-or-list (cons dirname (cdr dir-or-list)))
      (setq dir-or-list dirname))
    (dired-internal-noselect dir-or-list switches)))
776

777 778 779 780 781
;; 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))
782 783 784
	     (modtime (visited-file-modtime)))
	 (or (eq modtime 0)
	     (not (eq (car attributes) t))
785
	     (equal (nth 5 attributes) modtime)))))
786 787 788 789 790 791 792 793 794 795

(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)
796 797 798
	 ;; Do not auto-revert when the dired buffer can be currently
	 ;; written by the user as in `wdired-mode'.
	 buffer-read-only
799 800
	 (dired-directory-changed-p dirname))))

801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817
(defcustom dired-auto-revert-buffer nil
  "Automatically revert dired buffer on revisiting.
If t, revisiting an existing dired buffer automatically reverts it.
If its value is a function, call this function with the directory
name as single argument and revert the buffer if it returns non-nil.
Otherwise, a message offering to revert the changed dired buffer
is displayed.
Note that this is not the same as `auto-revert-mode' that
periodically reverts at specified time intervals."
  :type '(choice
          (const :tag "Don't revert" nil)
          (const :tag "Always revert visited dired buffer" t)
          (const :tag "Revert changed dired buffer" dired-directory-changed-p)
          (function :tag "Predicate function"))
  :group 'dired
  :version "23.2")

818
(defun dired-internal-noselect (dir-or-list &optional switches mode)
819 820 821
  ;; 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.
822
  ;; The user can type `g' easily, and it is more consistent with find-file.
823 824 825 826 827
  ;; 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.
828 829
  ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
  ;; see there.
830 831 832 833 834 835
  (let* ((old-buf (current-buffer))
	 (dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
         ;; Look for an existing buffer.
         (buffer (dired-find-buffer-nocreate dirname mode))
	 ;; Note that buffer already is in dired-mode, if found.
	 (new-buffer-p (null buffer)))
836
    (or buffer
837
        (setq buffer (create-file-buffer (directory-file-name dirname))))
838
    (set-buffer buffer)
839 840
    (if (not new-buffer-p)		; existing buffer ...
	(cond (switches			; ... but new switches
841
	       ;; file list may have changed
842
	       (setq dired-directory dir-or-list)
843
	       ;; this calls dired-revert
Juanma Barranquero's avatar
Juanma Barranquero committed
844
	       (dired-sort-other switches))
845 846 847 848 849 850 851 852
	      ;; Always revert regardless of whether it has changed or not.
	      ((eq dired-auto-revert-buffer t)
	       (revert-buffer))
	      ;; Revert when predicate function returns non-nil.
	      ((functionp dired-auto-revert-buffer)
	       (when (funcall dired-auto-revert-buffer dirname)
		 (revert-buffer)
		 (message "Changed directory automatically updated")))
853
	      ;; If directory has changed on disk, offer to revert.
854
	      ((when (dired-directory-changed-p dirname)
855
		 (message "%s"
Karl Heuer's avatar
Karl Heuer committed
856 857
			  (substitute-command-keys
			   "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
858
      ;; Else a new buffer
859
      (setq default-directory
860 861 862 863 864
	    ;; We can do this unconditionally
	    ;; because dired-noselect ensures that the name
	    ;; is passed in directory name syntax
	    ;; if it was the name of a directory at all.
	    (file-name-directory dirname))
865
      (or switches (setq switches dired-listing-switches))
866
      (if mode (funcall mode)
867
        (dired-mode dir-or-list switches))
868 869 870 871
      ;; default-directory and dired-actual-switches are set now
      ;; (buffer-local), so we can call dired-readin:
      (let ((failed t))
	(unwind-protect
872
	    (progn (dired-readin)
873 874 875 876 877 878 879
		   (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))))
      (goto-char (point-min))
      (dired-initial-position dirname))
    (set-buffer old-buf)
Eric S. Raymond's avatar
Eric S. Raymond committed
880 881
    buffer))

882 883 884 885 886 887
(defvar dired-buffers nil
  ;; Enlarged by dired-advertise
  ;; Queried by function dired-buffers-for-dir. When this detects a
  ;; killed buffer, it is removed from this list.
  "Alist of expanded directories and their associated dired buffers.")

888 889 890
(defvar dired-find-subdir)

;; FIXME add a doc-string, and document dired-x extensions.
891 892 893 894
(defun dired-find-buffer-nocreate (dirname &optional mode)
  ;; This differs from dired-buffers-for-dir in that it does not consider
  ;; subdirs of default-directory and searches for the first match only.
  ;; Also, the major mode must be MODE.
895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928
  (if (and (featurep 'dired-x)
           dired-find-subdir
           ;; Don't try to find a wildcard as a subdirectory.
	   (string-equal dirname (file-name-directory dirname)))
      (let* ((cur-buf (current-buffer))
	     (buffers (nreverse
		       (dired-buffers-for-dir (expand-file-name dirname))))
	     (cur-buf-matches (and (memq cur-buf buffers)
				   ;; Wildcards must match, too:
				   (equal dired-directory dirname))))
	;; We don't want to switch to the same buffer---
	(setq buffers (delq cur-buf buffers))
	(or (car (sort buffers #'dired-buffer-more-recently-used-p))
	    ;; ---unless it's the only possibility:
	    (and cur-buf-matches cur-buf)))
    ;; No dired-x, or dired-find-subdir nil.
    (setq dirname (expand-file-name dirname))
    (let (found (blist dired-buffers))    ; was (buffer-list)
      (or mode (setq mode 'dired-mode))
      (while blist
        (if (null (buffer-name (cdr (car blist))))
            (setq blist (cdr blist))
          (with-current-buffer (cdr (car blist))
            (if (and (eq major-mode mode)
                     dired-directory  ;; nil during find-alternate-file
                     (equal dirname
                            (expand-file-name
                             (if (consp dired-directory)
                                 (car dired-directory)
                               dired-directory))))
                (setq found (cdr (car blist))
                      blist nil)
              (setq blist (cdr blist))))))
      found)))
929

Dave Love's avatar
Dave Love committed
930

931 932
;; Read in a new dired buffer

933
(defun dired-readin ()
934
  "Read in a new dired buffer.
935
Differs from `dired-insert-subdir' in that it accepts
936 937 938
wildcards, erases the buffer, and builds the subdir-alist anew
\(including making it buffer-local and clearing it first)."

939 940
  ;; default-directory and dired-actual-switches must be buffer-local
  ;; and initialized by now.
941 942 943 944 945
  (let (dirname
	;; This makes readin much much faster.
	;; In particular, it prevents the font lock hook from running
	;; until the directory is all read in.
	(inhibit-modification-hooks t))
946 947 948
    (if (consp dired-directory)
	(setq dirname (car dired-directory))
      (setq dirname dired-directory))
949 950
    (setq dirname (expand-file-name dirname))
    (save-excursion
951 952 953 954 955 956
      ;; This hook which may want to modify dired-actual-switches
      ;; 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)
      (if (consp buffer-undo-list)
	  (setq buffer-undo-list nil))
957 958 959
      (make-local-variable 'file-name-coding-system)
      (setq file-name-coding-system
	    (or coding-system-for-read file-name-coding-system))
960
      (let ((inhibit-read-only t)
961 962
	    ;; Don't make undo entries for readin.
	    (buffer-undo-list t))
963 964
	(widen)
	(erase-buffer)
965 966
	(dired-readin-insert))
      (goto-char (point-min))
967 968 969
      ;; 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)
970
      (dired-build-subdir-alist)
971 972 973
      (let ((attributes (file-attributes dirname)))
	(if (eq (car attributes) t)
	    (set-visited-file-modtime (nth 5 attributes))))
974 975 976 977 978 979
      (set-buffer-modified-p nil)
      ;; 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))))
980 981 982

;; Subroutines of dired-readin

983 984 985 986 987 988 989 990 991
(defun dired-readin-insert ()
  ;; Insert listing for the specified dir (and maybe file list)
  ;; already in dired-directory, assuming a clean buffer.
  (let (dir file-list)
    (if (consp dired-directory)
	(setq dir (car dired-directory)
	      file-list (cdr dired-directory))
      (setq dir dired-directory
	    file-list nil))
992
    (setq dir (expand-file-name dir))
993 994
    (if (and (equal "" (file-name-nondirectory dir))
	     (not file-list))
995
	;; If we are reading a whole single directory...
996
	(dired-insert-directory dir dired-actual-switches nil nil t)
997
      (if (not (file-readable-p
998 999 1000 1001 1002 1003 1004
		(directory-file-name (file-name-directory dir))))
	  (error "Directory %s inaccessible or nonexistent" dir)
	;; Else treat it as a wildcard spec
	;; unless we have an explicit list of files.
	(dired-insert-directory dir dired-actual-switches
				file-list (not file-list) t)))))

1005 1006 1007 1008 1009 1010 1011 1012 1013 1014
(defun dired-align-file (beg end)
  "Align the fields of a file to the ones of surrounding lines.
BEG..END is the line where the file info is located."
  ;; Some versions of ls try to adjust the size of each field so as to just
  ;; hold the largest element ("largest" in the current invocation, of
  ;; course).  So when a single line is output, the size of each field is
  ;; just big enough for that one output.  Thus when dired refreshes one
  ;; line, the alignment if this line w.r.t the rest is messed up because
  ;; the fields of that one line will generally be smaller.
  ;;
1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
  ;; To work around this problem, we here add spaces to try and
  ;; re-align the fields as needed.  Since this is purely aesthetic,
  ;; it is of utmost importance that it doesn't mess up anything like
  ;; `dired-move-to-filename'.  To this end, we limit ourselves to
  ;; adding spaces only, and to only add them at places where there
  ;; was already at least one space.  This way, as long as
  ;; `directory-listing-before-filename-regexp' always matches spaces
  ;; with "*" or "+", we know we haven't made anything worse.  There
  ;; is one spot where the exact number of spaces is important, which
  ;; is just before the actual filename, so we refrain from adding
  ;; spaces there (and within the filename as well, of course).
1026 1027
  (save-excursion
    (let (file file-col other other-col)
Paul Eggert's avatar
Paul Eggert committed
1028
      ;; Check that there is indeed a file, and that there is another adjacent