(recentf-open-files-item): Include newline in button
[bpt/emacs.git] / lisp / dired.el
CommitLineData
c8472948 1;;; dired.el --- directory-browsing commands
52041219 2
87ae59e3 3;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
aaef169d 4;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
ab67260b 5
b36b40ae
RS
6;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
7;; Maintainer: FSF
565132a3 8;; Keywords: files
84fc2cfa
ER
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
52041219 14;; the Free Software Foundation; either version 2, or (at your option)
84fc2cfa
ER
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267 23;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
84fc2cfa 26
52041219
RS
27;;; Commentary:
28
e41b2db1
ER
29;; This is a major mode for directory browsing and editing. It is
30;; documented in the Emacs manual.
31
492d2437
RS
32;; Rewritten in 1990/1991 to add tree features, file marking and
33;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
34;; Finished up by rms in 1992.
35
52041219 36;;; Code:
492d2437 37
492d2437
RS
38;;; Customizable variables
39
286c247d
RS
40(defgroup dired nil
41 "Directory editing."
d7aed37c 42 :link '(custom-manual "(emacs)Dired")
ca66efd1 43 :group 'files)
286c247d
RS
44
45(defgroup dired-mark nil
68d2f12f 46 "Handling marks in Dired."
286c247d
RS
47 :prefix "dired-"
48 :group 'dired)
49
50
84fc2cfa 51;;;###autoload
286c247d 52(defcustom dired-listing-switches "-al"
ee680b2b 53 "*Switches passed to `ls' for Dired. MUST contain the `l' option.
492d2437 54May contain all other options that don't contradict `-l';
b36b40ae 55may contain even `F', `b', `i' and `s'. See also the variable
48404d5a
EZ
56`dired-ls-F-marks-symlinks' concerning the `F' switch.
57On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
58some of the `ls' switches are not supported; see the doc string of
ee680b2b 59`insert-directory' on `ls-lisp.el' for more details."
286c247d
RS
60 :type 'string
61 :group 'dired)
84fc2cfa 62
5553077c
LT
63(defvar dired-subdir-switches nil
64 "If non-nil, switches passed to `ls' for inserting subdirectories.
65If nil, `dired-listing-switches' is used.")
66
470fa6d1 67; Don't use absolute file names as /bin should be in any PATH and people
492d2437
RS
68; may prefer /usr/local/gnu/bin or whatever. However, chown is
69; usually not in PATH.
70
71;;;###autoload
84fc2cfa 72(defvar dired-chown-program
c60ee5e7 73 (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin))
6702f50d
RS
74 "chown"
75 (if (file-exists-p "/usr/sbin/chown")
76 "/usr/sbin/chown"
77 "/etc/chown"))
eb8c3be9 78 "Name of chown command (usually `chown' or `/etc/chown').")
492d2437 79
0b7bc76f
RS
80(defvar dired-use-ls-dired (not (not (string-match "gnu" system-configuration)))
81 "Non-nil means Dired should use `ls --dired'.")
82
912aace8
GV
83(defvar dired-chmod-program "chmod"
84 "Name of chmod command (usually `chmod').")
723ddb1f 85
57654b8c
JL
86(defvar dired-touch-program "touch"
87 "Name of touch command (usually `touch').")
88
492d2437 89;;;###autoload
286c247d 90(defcustom dired-ls-F-marks-symlinks nil
ee680b2b 91 "*Informs Dired about how `ls -lF' marks symbolic links.
fc83abf7
RS
92Set this to t if `ls' (or whatever program is specified by
93`insert-directory-program') with `-lF' marks the symbolic link
492d2437 94itself with a trailing @ (usually the case under Ultrix).
84fc2cfa 95
492d2437
RS
96Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
97nil (the default), if it gives `bar@ -> foo', set it to t.
98
99Dired checks if there is really a @ appended. Thus, if you have a
100marking `ls' program on one host and a non-marking on another host, and
101don't care about symbolic links which really end in a @, you can
286c247d
RS
102always set this variable to t."
103 :type 'boolean
104 :group 'dired-mark)
492d2437
RS
105
106;;;###autoload
286c247d 107(defcustom dired-trivial-filenames "^\\.\\.?$\\|^#"
492d2437
RS
108 "*Regexp of files to skip when finding first file of a directory.
109A value of nil means move to the subdir line.
286c247d
RS
110A value of t means move to first file."
111 :type '(choice (const :tag "Move to subdir" nil)
112 (const :tag "Move to first" t)
113 regexp)
114 :group 'dired)
492d2437
RS
115
116;;;###autoload
286c247d 117(defcustom dired-keep-marker-rename t
492d2437
RS
118 ;; Use t as default so that moved files "take their markers with them".
119 "*Controls marking of renamed files.
120If t, files keep their previous marks when they are renamed.
121If a character, renamed files (whether previously marked or not)
286c247d
RS
122are afterward marked with that character."
123 :type '(choice (const :tag "Keep" t)
124 (character :tag "Mark"))
125 :group 'dired-mark)
492d2437
RS
126
127;;;###autoload
286c247d 128(defcustom dired-keep-marker-copy ?C
492d2437
RS
129 "*Controls marking of copied files.
130If t, copied files are marked if and as the corresponding original files were.
286c247d
RS
131If a character, copied files are unconditionally marked with that character."
132 :type '(choice (const :tag "Keep" t)
133 (character :tag "Mark"))
134 :group 'dired-mark)
492d2437
RS
135
136;;;###autoload
286c247d 137(defcustom dired-keep-marker-hardlink ?H
492d2437
RS
138 "*Controls marking of newly made hard links.
139If t, they are marked if and as the files linked to were marked.
286c247d
RS
140If a character, new links are unconditionally marked with that character."
141 :type '(choice (const :tag "Keep" t)
142 (character :tag "Mark"))
143 :group 'dired-mark)
492d2437
RS
144
145;;;###autoload
286c247d 146(defcustom dired-keep-marker-symlink ?Y
492d2437
RS
147 "*Controls marking of newly made symbolic links.
148If t, they are marked if and as the files linked to were marked.
286c247d
RS
149If a character, new links are unconditionally marked with that character."
150 :type '(choice (const :tag "Keep" t)
151 (character :tag "Mark"))
152 :group 'dired-mark)
492d2437
RS
153
154;;;###autoload
286c247d 155(defcustom dired-dwim-target nil
ee680b2b 156 "*If non-nil, Dired tries to guess a default target directory.
492d2437
RS
157This means: if there is a dired buffer displayed in the next window,
158use its current subdir, instead of the current subdir of this dired buffer.
159
286c247d
RS
160The target is used in the prompt for file copy, rename etc."
161 :type 'boolean
162 :group 'dired)
492d2437
RS
163
164;;;###autoload
286c247d 165(defcustom dired-copy-preserve-time t
492d2437 166 "*If non-nil, Dired preserves the last-modified time in a file copy.
286c247d
RS
167\(This works on only some systems.)"
168 :type 'boolean
169 :group 'dired)
492d2437 170
05b855f5
EZ
171; These variables were deleted and the replacements are on files.el.
172; We leave aliases behind for back-compatibility.
173(defvaralias 'dired-free-space-program 'directory-free-space-program)
174(defvaralias 'dired-free-space-args 'directory-free-space-args)
175
492d2437
RS
176;;; Hook variables
177
c2792945 178(defcustom dired-load-hook nil
ee680b2b 179 "Run after loading Dired.
c2792945
EZ
180You can customize key bindings or load extensions with this."
181 :group 'dired
182 :type 'hook)
492d2437 183
c2792945 184(defcustom dired-mode-hook nil
ee680b2b 185 "Run at the very end of `dired-mode'."
c2792945
EZ
186 :group 'dired
187 :type 'hook)
492d2437 188
c2792945
EZ
189(defcustom dired-before-readin-hook nil
190 "This hook is run before a dired buffer is read in (created or reverted)."
191 :group 'dired
192 :type 'hook)
492d2437 193
c2792945 194(defcustom dired-after-readin-hook nil
492d2437
RS
195 "Hook run after each time a file or directory is read by Dired.
196After each listing of a file or directory, this hook is run
c2792945
EZ
197with the buffer narrowed to the listing."
198 :group 'dired
199 :type 'hook)
492d2437
RS
200;; Note this can't simply be run inside function `dired-ls' as the hook
201;; functions probably depend on the dired-subdir-alist to be OK.
202
1ed8284d
RS
203(defcustom dired-dnd-protocol-alist
204 '(("^file:///" . dired-dnd-handle-local-file)
205 ("^file://" . dired-dnd-handle-file)
206 ("^file:" . dired-dnd-handle-local-file))
207 "The functions to call when a drop in `dired-mode' is made.
208See `dnd-protocol-alist' for more information. When nil, behave
209as in other buffers."
210 :type '(choice (repeat (cons (regexp) (function)))
211 (const :tag "Behave as in other buffers" nil))
212 :version "22.1"
213 :group 'dired)
214
2b2059d8 215;; Internal variables
492d2437
RS
216
217(defvar dired-marker-char ?* ; the answer is 42
218 ;; so that you can write things like
219 ;; (let ((dired-marker-char ?X))
220 ;; ;; great code using X markers ...
221 ;; )
222 ;; For example, commands operating on two sets of files, A and B.
223 ;; Or marking files with digits 0-9. This could implicate
224 ;; concentric sets or an order for the marked files.
225 ;; The code depends on dynamic scoping on the marker char.
226 "In Dired, the current mark character.
884b7f9d 227This is what the do-commands look for, and what the mark-commands store.")
492d2437
RS
228
229(defvar dired-del-marker ?D
230 "Character used to flag files for deletion.")
231
ee680b2b 232(defvar dired-shrink-to-fit t
ab67260b
RS
233;; I see no reason ever to make this nil -- rms.
234;; (> baud-rate search-slow-speed)
492d2437
RS
235 "Non-nil means Dired shrinks the display buffer to fit the marked files.")
236
237(defvar dired-flagging-regexp nil);; Last regexp used to flag files.
238
ab67260b
RS
239(defvar dired-file-version-alist)
240
e956c609 241;;;###autoload
492d2437 242(defvar dired-directory nil
ee680b2b 243 "The directory name or wildcard spec that this dired directory lists.
8d23c16b 244Local to each dired buffer. May be a list, in which case the car is the
0b7bc76f
RS
245directory name and the cdr is the list of files to mention.
246The directory name must be absolute, but need not be fully expanded.")
492d2437
RS
247
248(defvar dired-actual-switches nil
249 "The value of `dired-listing-switches' used to make this buffer's text.")
250
251(defvar dired-re-inode-size "[0-9 \t]*"
252 "Regexp for optional initial inode and file size as made by `ls -i -s'.")
253
254;; These regexps must be tested at beginning-of-line, but are also
255;; used to search for next matches, so neither omitting "^" nor
256;; replacing "^" by "\n" (to make it slightly faster) will work.
257
258(defvar dired-re-mark "^[^ \n]")
259;; "Regexp matching a marked line.
260;; Important: the match ends just after the marker."
261(defvar dired-re-maybe-mark "^. ")
312a9e03
EZ
262;; The [^:] part after "d" and "l" is to avoid confusion with the
263;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
264(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
265(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
492d2437
RS
266(defvar dired-re-exe;; match ls permission string of an executable file
267 (mapconcat (function
268 (lambda (x)
269 (concat dired-re-maybe-mark dired-re-inode-size x)))
270 '("-[-r][-w][xs][-r][-w].[-r][-w]."
271 "-[-r][-w].[-r][-w][xs][-r][-w]."
272 "-[-r][-w].[-r][-w].[-r][-w][xst]")
273 "\\|"))
e6cecd2b 274(defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
147e214c 275(defvar dired-re-dot "^.* \\.\\.?/?$")
492d2437 276
5553077c 277;; The subdirectory names in the next two lists are expanded.
492d2437
RS
278(defvar dired-subdir-alist nil
279 "Association list of subdirectories and their buffer positions.
280Each subdirectory has an element: (DIRNAME . STARTMARKER).
7b2469ae
RS
281The order of elements is the reverse of the order in the buffer.
282In simple cases, this list contains one element.")
492d2437 283
5553077c
LT
284(defvar dired-switches-alist nil
285 "Keeps track of which switches to use for inserted subdirectories.
286This is an alist of the form (SUBDIR . SWITCHES).")
287(make-variable-buffer-local 'dired-switches-alist)
288
5afea280
RS
289(defvaralias 'dired-move-to-filename-regexp
290 'directory-listing-before-filename-regexp)
291
cdf156a9 292(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
492d2437
RS
293 "Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
294Subexpression 1 is the subdirectory proper, no trailing colon.
295The match starts at the beginning of the line and ends after the end
296of the line (\\n or \\r).
297Subexpression 2 must end right before the \\n or \\r.")
298
0b0e6651 299(defgroup dired-faces nil
ee680b2b 300 "Faces used by Dired."
0b0e6651
JL
301 :group 'dired
302 :group 'faces)
303
304(defface dired-header
305 '((t (:inherit font-lock-type-face)))
306 "Face used for directory headers."
307 :group 'dired-faces
bf247b6e 308 :version "22.1")
0b0e6651
JL
309(defvar dired-header-face 'dired-header
310 "Face name used for directory headers.")
311
312(defface dired-mark
313 '((t (:inherit font-lock-constant-face)))
314 "Face used for dired marks."
315 :group 'dired-faces
bf247b6e 316 :version "22.1")
0b0e6651
JL
317(defvar dired-mark-face 'dired-mark
318 "Face name used for dired marks.")
319
320(defface dired-marked
321 '((t (:inherit font-lock-warning-face)))
322 "Face used for marked files."
323 :group 'dired-faces
bf247b6e 324 :version "22.1")
0b0e6651
JL
325(defvar dired-marked-face 'dired-marked
326 "Face name used for marked files.")
327
328(defface dired-flagged
329 '((t (:inherit font-lock-warning-face)))
330 "Face used for flagged files."
331 :group 'dired-faces
bf247b6e 332 :version "22.1")
0b0e6651
JL
333(defvar dired-flagged-face 'dired-flagged
334 "Face name used for flagged files.")
335
336(defface dired-warning
337 '((t (:inherit font-lock-comment-face)))
338 "Face used to highlight a part of a buffer that needs user attention."
339 :group 'dired-faces
bf247b6e 340 :version "22.1")
0b0e6651
JL
341(defvar dired-warning-face 'dired-warning
342 "Face name used for a part of a buffer that needs user attention.")
343
344(defface dired-directory
345 '((t (:inherit font-lock-function-name-face)))
346 "Face used for subdirectories."
347 :group 'dired-faces
bf247b6e 348 :version "22.1")
0b0e6651
JL
349(defvar dired-directory-face 'dired-directory
350 "Face name used for subdirectories.")
351
352(defface dired-symlink
353 '((t (:inherit font-lock-keyword-face)))
354 "Face used for symbolic links."
355 :group 'dired-faces
bf247b6e 356 :version "22.1")
0b0e6651
JL
357(defvar dired-symlink-face 'dired-symlink
358 "Face name used for symbolic links.")
359
360(defface dired-ignored
cf78a467 361 '((t (:inherit shadow)))
0b0e6651
JL
362 "Face used for files suffixed with `completion-ignored-extensions'."
363 :group 'dired-faces
bf247b6e 364 :version "22.1")
0b0e6651
JL
365(defvar dired-ignored-face 'dired-ignored
366 "Face name used for files suffixed with `completion-ignored-extensions'.")
367
2439570d
SM
368(defvar dired-font-lock-keywords
369 (list
370 ;;
371 ;; Directory headers.
0b0e6651
JL
372 (list dired-subdir-regexp '(1 dired-header-face))
373 ;;
374 ;; Dired marks.
375 (list dired-re-mark '(0 dired-mark-face))
2439570d
SM
376 ;;
377 ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
378 ;; file name itself. We search for Dired defined regexps, and then use the
379 ;; Dired defined function `dired-move-to-filename' before searching for the
380 ;; simple regexp ".+". It is that regexp which matches the file name.
381 ;;
0b0e6651
JL
382 ;; Marked files.
383 (list (concat "^[" (char-to-string dired-marker-char) "]")
384 '(".+" (dired-move-to-filename) nil (0 dired-marked-face)))
385 ;;
386 ;; Flagged files.
387 (list (concat "^[" (char-to-string dired-del-marker) "]")
388 '(".+" (dired-move-to-filename) nil (0 dired-flagged-face)))
4fdf389a
RS
389 ;; People who are paranoid about security would consider this more
390 ;; important than other things such as whether it is a directory.
391 ;; But we don't want to encourage paranoia, so our default
392 ;; should be what's most useful for non-paranoids. -- rms.
393;;; ;;
394;;; ;; Files that are group or world writable.
395;;; (list (concat dired-re-maybe-mark dired-re-inode-size
396;;; "\\([-d]\\(....w....\\|.......w.\\)\\)")
0b0e6651
JL
397;;; '(1 dired-warning-face)
398;;; '(".+" (dired-move-to-filename) nil (0 dired-warning-face)))
d7aed37c
SM
399 ;; However, we don't need to highlight the file name, only the
400 ;; permissions, to win generally. -- fx.
401 ;; Fixme: we could also put text properties on the permission
402 ;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
403 (list (concat dired-re-maybe-mark dired-re-inode-size
f16bcc9a 404 "[-d]....\\(w\\)....") ; group writable
0b0e6651 405 '(1 dired-warning-face))
d7aed37c 406 (list (concat dired-re-maybe-mark dired-re-inode-size
f16bcc9a 407 "[-d].......\\(w\\).") ; world writable
0b0e6651 408 '(1 dired-warning-face))
2439570d
SM
409 ;;
410 ;; Subdirectories.
411 (list dired-re-dir
0b0e6651 412 '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
2439570d
SM
413 ;;
414 ;; Symbolic links.
c60ee5e7 415 (list dired-re-sym
0b0e6651 416 '(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
2439570d
SM
417 ;;
418 ;; Files suffixed with `completion-ignored-extensions'.
419 '(eval .
2b2059d8
SM
420 ;; It is quicker to first find just an extension, then go back to the
421 ;; start of that file name. So we do this complex MATCH-ANCHORED form.
422 (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
2225a196
RS
423 '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
424 ;;
425 ;; Files suffixed with `completion-ignored-extensions'
426 ;; plus a character put in by -F.
427 '(eval .
428 (list (concat "\\(" (regexp-opt completion-ignored-extensions)
429 "\\|#\\)[*=|]$")
430 '(".+" (progn
431 (end-of-line)
432 ;; If the last character is not part of the filename,
433 ;; move back to the start of the filename
434 ;; so it can be fontified.
435 ;; Otherwise, leave point at the end of the line;
436 ;; that way, nothing is fontified.
437 (unless (get-text-property (1- (point)) 'mouse-face)
438 (dired-move-to-filename)))
439 nil (0 dired-ignored-face))))
440)
2439570d 441 "Additional expressions to highlight in Dired mode.")
65536d1d
RS
442
443(defvar dnd-protocol-alist)
83fadedf 444\f
492d2437
RS
445;;; Macros must be defined before they are used, for the byte compiler.
446
492d2437 447(defmacro dired-mark-if (predicate msg)
d7aed37c
SM
448 "Mark all files for which PREDICATE evals to non-nil.
449PREDICATE is evaluated on each line, with point at beginning of line.
450MSG is a noun phrase for the type of files being marked.
451It should end with a noun that can be pluralized by adding `s'.
452Return value is the number of files marked, or nil if none were marked."
8a946354
SS
453 `(let (buffer-read-only count)
454 (save-excursion
455 (setq count 0)
456 (if ,msg (message "Marking %ss..." ,msg))
457 (goto-char (point-min))
458 (while (not (eobp))
459 (if ,predicate
460 (progn
461 (delete-char 1)
462 (insert dired-marker-char)
463 (setq count (1+ count))))
464 (forward-line 1))
465 (if ,msg (message "%s %s%s %s%s."
466 count
467 ,msg
468 (dired-plural-s count)
469 (if (eq dired-marker-char ?\040) "un" "")
470 (if (eq dired-marker-char dired-del-marker)
471 "flagged" "marked"))))
472 (and (> count 0) count)))
492d2437 473
09b092ad
RS
474(defmacro dired-map-over-marks (body arg &optional show-progress
475 distinguish-one-marked)
91947235
SM
476 "Eval BODY with point on each marked line. Return a list of BODY's results.
477If no marked file could be found, execute BODY on the current line.
478 If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
479 files instead of the marked files.
480 In that case point is dragged along. This is so that commands on
481 the next ARG (instead of the marked) files can be chained easily.
482 If ARG is otherwise non-nil, use current file instead.
483If optional third arg SHOW-PROGRESS evaluates to non-nil,
484 redisplay the dired buffer after each file is processed.
485No guarantee is made about the position on the marked line.
486 BODY must ensure this itself if it depends on this.
487Search starts at the beginning of the buffer, thus the car of the list
488 corresponds to the line nearest to the buffer's bottom. This
489 is also true for (positive and negative) integer values of ARG.
09b092ad
RS
490BODY should not be too long as it is expanded four times.
491
492If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
493return (t FILENAME) instead of (FILENAME)."
91947235
SM
494 ;;
495 ;;Warning: BODY must not add new lines before point - this may cause an
496 ;;endless loop.
497 ;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
498 `(prog1
499 (let (buffer-read-only case-fold-search found results)
500 (if ,arg
501 (if (integerp ,arg)
502 (progn ;; no save-excursion, want to move point.
503 (dired-repeat-over-lines
504 ,arg
505 (function (lambda ()
506 (if ,show-progress (sit-for 0))
507 (setq results (cons ,body results)))))
508 (if (< ,arg 0)
509 (nreverse results)
510 results))
511 ;; non-nil, non-integer ARG means use current file:
512 (list ,body))
513 (let ((regexp (dired-marker-regexp)) next-position)
514 (save-excursion
515 (goto-char (point-min))
516 ;; remember position of next marked file before BODY
517 ;; can insert lines before the just found file,
518 ;; confusing us by finding the same marked file again
519 ;; and again and...
520 (setq next-position (and (re-search-forward regexp nil t)
521 (point-marker))
522 found (not (null next-position)))
523 (while next-position
524 (goto-char next-position)
525 (if ,show-progress (sit-for 0))
526 (setq results (cons ,body results))
527 ;; move after last match
528 (goto-char next-position)
529 (forward-line 1)
530 (set-marker next-position nil)
492d2437 531 (setq next-position (and (re-search-forward regexp nil t)
91947235 532 (point-marker)))))
09b092ad
RS
533 (if (and ,distinguish-one-marked (= (length results) 1))
534 (setq results (cons t results)))
91947235
SM
535 (if found
536 results
537 (list ,body)))))
538 ;; save-excursion loses, again
539 (dired-move-to-filename)))
492d2437 540
09b092ad 541(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
492d2437
RS
542 "Return the marked files' names as list of strings.
543The list is in the same order as the buffer, that is, the car is the
544 first marked file.
1312bfc6 545Values returned are normally absolute file names.
492d2437 546Optional arg LOCALP as in `dired-get-filename'.
1312bfc6
RS
547Optional second argument ARG specifies files near point
548 instead of marked files. If ARG is an integer, use the next ARG files.
549 If ARG is otherwise non-nil, use file. Usually ARG comes from
550 the command's prefix arg.
551Optional third argument FILTER, if non-nil, is a function to select
09b092ad
RS
552 some of the files--those for which (funcall FILTER FILENAME) is non-nil.
553
554If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
555return (t FILENAME) instead of (FILENAME).
556Don't use that together with FILTER."
557 (let* ((all-of-them
558 (save-excursion
559 (dired-map-over-marks
560 (dired-get-filename localp)
561 arg nil distinguish-one-marked)))
562 result)
1312bfc6 563 (if (not filter)
09b092ad
RS
564 (if (and distinguish-one-marked (eq (car all-of-them) t))
565 all-of-them
566 (nreverse all-of-them))
1312bfc6
RS
567 (dolist (file all-of-them)
568 (if (funcall filter file)
569 (push file result)))
570 result)))
83fadedf 571\f
492d2437
RS
572;; The dired command
573
574(defun dired-read-dir-and-switches (str)
575 ;; For use in interactive.
576 (reverse (list
577 (if current-prefix-arg
578 (read-string "Dired listing switches: "
579 dired-listing-switches))
8d9e2a49
JD
580 ;; If a dialog is about to be used, call read-directory-name so
581 ;; the dialog code knows we want directories. Some dialogs can
582 ;; only select directories or files when popped up, not both.
583 (if (next-read-file-uses-dialog-p)
584 (read-directory-name (format "Dired %s(directory): " str)
585 nil default-directory nil)
586 (read-file-name (format "Dired %s(directory): " str)
587 nil default-directory nil)))))
84fc2cfa 588
492d2437 589;;;###autoload (define-key ctl-x-map "d" 'dired)
84fc2cfa 590;;;###autoload
492d2437 591(defun dired (dirname &optional switches)
84fc2cfa 592 "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
492d2437
RS
593Optional second argument SWITCHES specifies the `ls' options used.
594\(Interactively, use a prefix argument to be able to specify SWITCHES.)
595Dired displays a list of files in DIRNAME (which may also have
8d23c16b 596shell wildcards appended to select certain files). If DIRNAME is a cons,
1015daba 597its first element is taken as the directory name and the rest as an explicit
8d23c16b 598list of files to make directory entries for.
52041219 599\\<dired-mode-map>\
492d2437 600You can move around in it with the usual commands.
8d23c16b
ER
601You can flag files for deletion with \\[dired-flag-file-deletion] and then
602delete them by typing \\[dired-do-flagged-delete].
ee680b2b 603Type \\[describe-mode] after entering Dired for more info.
84fc2cfa 604
492d2437
RS
605If DIRNAME is already in a dired buffer, that buffer is used without refresh."
606 ;; Cannot use (interactive "D") because of wildcards.
607 (interactive (dired-read-dir-and-switches ""))
608 (switch-to-buffer (dired-noselect dirname switches)))
609
610;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
84fc2cfa 611;;;###autoload
492d2437 612(defun dired-other-window (dirname &optional switches)
84fc2cfa 613 "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
492d2437
RS
614 (interactive (dired-read-dir-and-switches "in other window "))
615 (switch-to-buffer-other-window (dired-noselect dirname switches)))
84fc2cfa 616
ec03e49c
RS
617;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
618;;;###autoload
619(defun dired-other-frame (dirname &optional switches)
620 "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
621 (interactive (dired-read-dir-and-switches "in other frame "))
622 (switch-to-buffer-other-frame (dired-noselect dirname switches)))
623
84fc2cfa 624;;;###autoload
8d23c16b 625(defun dired-noselect (dir-or-list &optional switches)
84fc2cfa 626 "Like `dired' but returns the dired buffer as value, does not select it."
8d23c16b 627 (or dir-or-list (setq dir-or-list default-directory))
492d2437
RS
628 ;; This loses the distinction between "/foo/*/" and "/foo/*" that
629 ;; some shells make:
54df7d9a 630 (let (dirname initially-was-dirname)
8d23c16b
ER
631 (if (consp dir-or-list)
632 (setq dirname (car dir-or-list))
633 (setq dirname dir-or-list))
54df7d9a
RS
634 (setq initially-was-dirname
635 (string= (file-name-as-directory dirname) dirname))
370b6149
RS
636 (setq dirname (abbreviate-file-name
637 (expand-file-name (directory-file-name dirname))))
cb2e51f8
RS
638 (if find-file-visit-truename
639 (setq dirname (file-truename dirname)))
54df7d9a
RS
640 ;; If the argument was syntactically a directory name not a file name,
641 ;; or if it happens to name a file that is a directory,
642 ;; convert it syntactically to a directory name.
643 ;; The reason for checking initially-was-dirname
644 ;; and not just file-directory-p
645 ;; is that file-directory-p is slow over ftp.
646 (if (or initially-was-dirname (file-directory-p dirname))
647 (setq dirname (file-name-as-directory dirname)))
8d23c16b
ER
648 (if (consp dir-or-list)
649 (setq dir-or-list (cons dirname (cdr dir-or-list)))
650 (setq dir-or-list dirname))
651 (dired-internal-noselect dir-or-list switches)))
492d2437 652
573e4d2d
LT
653;; The following is an internal dired function. It returns non-nil if
654;; the directory visited by the current dired buffer has changed on
655;; disk. DIRNAME should be the directory name of that directory.
656(defun dired-directory-changed-p (dirname)
657 (not (let ((attributes (file-attributes dirname))
e09cd94f
LT
658 (modtime (visited-file-modtime)))
659 (or (eq modtime 0)
660 (not (eq (car attributes) t))
ca02a726 661 (equal (nth 5 attributes) modtime)))))
573e4d2d
LT
662
663(defun dired-buffer-stale-p (&optional noconfirm)
664 "Return non-nil if current dired buffer needs updating.
665If NOCONFIRM is non-nil, then this function always returns nil
666for a remote directory. This feature is used by Auto Revert Mode."
667 (let ((dirname
668 (if (consp dired-directory) (car dired-directory) dired-directory)))
669 (and (stringp dirname)
670 (not (when noconfirm (file-remote-p dirname)))
671 (file-readable-p dirname)
672 (dired-directory-changed-p dirname))))
673
492d2437 674;; Separate function from dired-noselect for the sake of dired-vms.el.
6a4cd605 675(defun dired-internal-noselect (dir-or-list &optional switches mode)
492d2437
RS
676 ;; If there is an existing dired buffer for DIRNAME, just leave
677 ;; buffer as it is (don't even call dired-revert).
678 ;; This saves time especially for deep trees or with ange-ftp.
573e4d2d 679 ;; The user can type `g' easily, and it is more consistent with find-file.
492d2437
RS
680 ;; But if SWITCHES are given they are probably different from the
681 ;; buffer's old value, so call dired-sort-other, which does
682 ;; revert the buffer.
683 ;; A pity we can't possibly do "Directory has changed - refresh? "
684 ;; like find-file does.
6a4cd605
RS
685 ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
686 ;; see there.
0b7bc76f
RS
687 (let* (dirname
688 buffer
492d2437 689 ;; note that buffer already is in dired-mode, if found
0b7bc76f 690 new-buffer-p
492d2437 691 (old-buf (current-buffer)))
0b7bc76f
RS
692 (if (consp dir-or-list)
693 (setq dirname (car dir-or-list))
694 (setq dirname dir-or-list))
695 ;; Look for an existing buffer.
696 (setq buffer (dired-find-buffer-nocreate dirname mode)
697 new-buffer-p (null buffer))
492d2437
RS
698 (or buffer
699 (let ((default-major-mode 'fundamental-mode))
700 ;; We don't want default-major-mode to run hooks and set auto-fill
701 ;; or whatever, now that dired-mode does not
702 ;; kill-all-local-variables any longer.
703 (setq buffer (create-file-buffer (directory-file-name dirname)))))
704 (set-buffer buffer)
573e4d2d
LT
705 (if (not new-buffer-p) ; existing buffer ...
706 (cond (switches ; ... but new switches
6cfd24f9 707 ;; file list may have changed
0b7bc76f 708 (setq dired-directory dir-or-list)
6cfd24f9 709 ;; this calls dired-revert
c60ee5e7 710 (dired-sort-other switches))
6cfd24f9 711 ;; If directory has changed on disk, offer to revert.
573e4d2d 712 ((when (dired-directory-changed-p dirname)
952e8cb5 713 (message "%s"
212b2266
KH
714 (substitute-command-keys
715 "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
492d2437 716 ;; Else a new buffer
847aabce 717 (setq default-directory
e3cd4b53
RS
718 ;; We can do this unconditionally
719 ;; because dired-noselect ensures that the name
720 ;; is passed in directory name syntax
721 ;; if it was the name of a directory at all.
722 (file-name-directory dirname))
492d2437 723 (or switches (setq switches dired-listing-switches))
6e5d9ec5 724 (if mode (funcall mode)
0b7bc76f 725 (dired-mode dir-or-list switches))
492d2437
RS
726 ;; default-directory and dired-actual-switches are set now
727 ;; (buffer-local), so we can call dired-readin:
728 (let ((failed t))
729 (unwind-protect
0b7bc76f 730 (progn (dired-readin)
492d2437
RS
731 (setq failed nil))
732 ;; dired-readin can fail if parent directories are inaccessible.
733 ;; Don't leave an empty buffer around in that case.
734 (if failed (kill-buffer buffer))))
492d2437
RS
735 (goto-char (point-min))
736 (dired-initial-position dirname))
737 (set-buffer old-buf)
84fc2cfa
ER
738 buffer))
739
c5753a5d
GM
740(defvar dired-buffers nil
741 ;; Enlarged by dired-advertise
742 ;; Queried by function dired-buffers-for-dir. When this detects a
743 ;; killed buffer, it is removed from this list.
744 "Alist of expanded directories and their associated dired buffers.")
745
6a4cd605
RS
746(defun dired-find-buffer-nocreate (dirname &optional mode)
747 ;; This differs from dired-buffers-for-dir in that it does not consider
748 ;; subdirs of default-directory and searches for the first match only.
749 ;; Also, the major mode must be MODE.
0b7bc76f 750 (setq dirname (expand-file-name dirname))
f5b06a95 751 (let (found (blist dired-buffers)) ; was (buffer-list)
6a4cd605 752 (or mode (setq mode 'dired-mode))
492d2437 753 (while blist
6103c44e
KH
754 (if (null (buffer-name (cdr (car blist))))
755 (setq blist (cdr blist))
756 (save-excursion
757 (set-buffer (cdr (car blist)))
6a4cd605 758 (if (and (eq major-mode mode)
59759f1f 759 dired-directory ;; nil during find-alternate-file
0b7bc76f
RS
760 (equal dirname
761 (expand-file-name
762 (if (consp dired-directory)
763 (car dired-directory)
764 dired-directory))))
6103c44e
KH
765 (setq found (cdr (car blist))
766 blist nil)
767 (setq blist (cdr blist))))))
492d2437
RS
768 found))
769
83fadedf 770\f
492d2437
RS
771;; Read in a new dired buffer
772
0b7bc76f 773(defun dired-readin ()
d7aed37c 774 "Read in a new dired buffer.
87ae59e3 775Differs from `dired-insert-subdir' in that it accepts
d7aed37c
SM
776wildcards, erases the buffer, and builds the subdir-alist anew
777\(including making it buffer-local and clearing it first)."
778
492d2437
RS
779 ;; default-directory and dired-actual-switches must be buffer-local
780 ;; and initialized by now.
0b7bc76f
RS
781 (let (dirname)
782 (if (consp dired-directory)
783 (setq dirname (car dired-directory))
784 (setq dirname dired-directory))
8d23c16b 785 (setq dirname (expand-file-name dirname))
8d23c16b 786 (save-excursion
0b7bc76f
RS
787 ;; This hook which may want to modify dired-actual-switches
788 ;; based on dired-directory, e.g. with ange-ftp to a SysV host
789 ;; where ls won't understand -Al switches.
790 (run-hooks 'dired-before-readin-hook)
0b7bc76f
RS
791 (if (consp buffer-undo-list)
792 (setq buffer-undo-list nil))
793 (let (buffer-read-only
794 ;; Don't make undo entries for readin.
795 (buffer-undo-list t))
8d23c16b
ER
796 (widen)
797 (erase-buffer)
0b7bc76f 798 (dired-readin-insert))
0b7bc76f 799 (goto-char (point-min))
8d23c16b
ER
800 ;; Must first make alist buffer local and set it to nil because
801 ;; dired-build-subdir-alist will call dired-clear-alist first
802 (set (make-local-variable 'dired-subdir-alist) nil)
8197b8bf 803 (dired-build-subdir-alist)
fa562dd5
RS
804 (let ((attributes (file-attributes dirname)))
805 (if (eq (car attributes) t)
806 (set-visited-file-modtime (nth 5 attributes))))
0b7bc76f
RS
807 (set-buffer-modified-p nil)
808 ;; No need to narrow since the whole buffer contains just
809 ;; dired-readin's output, nothing else. The hook can
810 ;; successfully use dired functions (e.g. dired-get-filename)
811 ;; as the subdir-alist has been built in dired-readin.
812 (run-hooks 'dired-after-readin-hook))))
492d2437
RS
813
814;; Subroutines of dired-readin
815
0b7bc76f
RS
816(defun dired-readin-insert ()
817 ;; Insert listing for the specified dir (and maybe file list)
818 ;; already in dired-directory, assuming a clean buffer.
819 (let (dir file-list)
820 (if (consp dired-directory)
821 (setq dir (car dired-directory)
822 file-list (cdr dired-directory))
823 (setq dir dired-directory
824 file-list nil))
34cd7b3c 825 (setq dir (expand-file-name dir))
0b7bc76f
RS
826 (if (and (equal "" (file-name-nondirectory dir))
827 (not file-list))
cf39fa9b 828 ;; If we are reading a whole single directory...
0b7bc76f 829 (dired-insert-directory dir dired-actual-switches nil nil t)
8d23c16b 830 (if (not (file-readable-p
0b7bc76f
RS
831 (directory-file-name (file-name-directory dir))))
832 (error "Directory %s inaccessible or nonexistent" dir)
833 ;; Else treat it as a wildcard spec
834 ;; unless we have an explicit list of files.
835 (dired-insert-directory dir dired-actual-switches
836 file-list (not file-list) t)))))
837
a12c6dca
SM
838(defun dired-align-file (beg end)
839 "Align the fields of a file to the ones of surrounding lines.
840BEG..END is the line where the file info is located."
841 ;; Some versions of ls try to adjust the size of each field so as to just
842 ;; hold the largest element ("largest" in the current invocation, of
843 ;; course). So when a single line is output, the size of each field is
844 ;; just big enough for that one output. Thus when dired refreshes one
845 ;; line, the alignment if this line w.r.t the rest is messed up because
846 ;; the fields of that one line will generally be smaller.
847 ;;
9bc260cf
MA
848 ;; To work around this problem, we here add spaces to try and
849 ;; re-align the fields as needed. Since this is purely aesthetic,
850 ;; it is of utmost importance that it doesn't mess up anything like
851 ;; `dired-move-to-filename'. To this end, we limit ourselves to
852 ;; adding spaces only, and to only add them at places where there
853 ;; was already at least one space. This way, as long as
854 ;; `directory-listing-before-filename-regexp' always matches spaces
855 ;; with "*" or "+", we know we haven't made anything worse. There
856 ;; is one spot where the exact number of spaces is important, which
857 ;; is just before the actual filename, so we refrain from adding
858 ;; spaces there (and within the filename as well, of course).
a12c6dca
SM
859 (save-excursion
860 (let (file file-col other other-col)
861 ;; Check the there is indeed a file, and that there is anoter adjacent
862 ;; file with which to align, and that additional spaces are needed to
863 ;; align the filenames.
864 (when (and (setq file (progn (goto-char beg)
865 (dired-move-to-filename nil end)))
866 (setq file-col (current-column))
867 (setq other
868 (or (and (goto-char beg)
869 (zerop (forward-line -1))
870 (dired-move-to-filename))
871 (and (goto-char beg)
872 (zerop (forward-line 1))
873 (dired-move-to-filename))))
874 (setq other-col (current-column))
875 (/= file other)
876 ;; Make sure there is some work left to do.
877 (> other-col file-col))
878 ;; If we've only looked at the line above, check to see if the line
879 ;; below exists as well and if so, align with the shorter one.
880 (when (and (< other file)
881 (goto-char beg)
882 (zerop (forward-line 1))
883 (dired-move-to-filename))
884 (let ((alt-col (current-column)))
885 (when (< alt-col other-col)
886 (setq other-col alt-col)
887 (setq other (point)))))
888 ;; Keep positions uptodate when we insert stuff.
889 (if (> other file) (setq other (copy-marker other)))
890 (setq file (copy-marker file))
891 ;; Main loop.
892 (goto-char beg)
87ae59e3 893 (skip-chars-forward " ") ;Skip to the first field.
a12c6dca 894 (while (and (> other-col file-col)
a12c6dca
SM
895 ;; Don't touch anything just before (and after) the
896 ;; beginning of the filename.
897 (> file (point)))
898 ;; We're now just in front of a field, with a space behind us.
899 (let* ((curcol (current-column))
900 ;; Nums are right-aligned.
901 (num-align (looking-at "[0-9]"))
902 ;; Let's look at the other line, in the same column: we
903 ;; should be either near the end of the previous field, or
904 ;; in the space between that field and the next.
905 ;; [ Of course, it's also possible that we're already within
906 ;; the next field or even past it, but that's unlikely since
907 ;; other-col > file-col. ]
908 ;; Let's find the distance to the alignment-point (either
909 ;; the beginning or the end of the next field, depending on
910 ;; whether this field is left or right aligned).
911 (align-pt-offset
912 (save-excursion
913 (goto-char other)
914 (move-to-column curcol)
915 (when (looking-at
916 (concat
ee680b2b 917 (if (eq (char-before) ?\s) " *" "[^ ]* *")
a12c6dca
SM
918 (if num-align "[0-9][^ ]*")))
919 (- (match-end 0) (match-beginning 0)))))
920 ;; Now, the number of spaces to insert is align-pt-offset
921 ;; minus the distance to the equivalent point on the
922 ;; current line.
923 (spaces
924 (if (not num-align)
925 align-pt-offset
926 (and align-pt-offset
927 (save-excursion
928 (skip-chars-forward "^ ")
929 (- align-pt-offset (- (current-column) curcol)))))))
930 (when (and spaces (> spaces 0))
931 (setq file-col (+ spaces file-col))
932 (if (> file-col other-col)
933 (setq spaces (- spaces (- file-col other-col))))
934 (insert-char ?\s spaces)
935 ;; Let's just make really sure we did not mess up.
936 (unless (save-excursion
87ae59e3 937 (eq (dired-move-to-filename) (marker-position file)))
a12c6dca 938 ;; Damn! We messed up: let's revert the change.
87ae59e3
SM
939 (delete-char (- spaces)))))
940 ;; Now skip to next field.
941 (skip-chars-forward "^ ") (skip-chars-forward " "))
a12c6dca 942 (set-marker file nil)))))
87ae59e3 943
a12c6dca 944
0b7bc76f
RS
945(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
946 "Insert a directory listing of DIR, Dired style.
947Use SWITCHES to make the listings.
948If FILE-LIST is non-nil, list only those files.
949Otherwise, if WILDCARD is non-nil, expand wildcards;
950 in that case, DIR should be a file name that uses wildcards.
951In other cases, DIR should be a directory name or a directory filename.
952If HDR is non-nil, insert a header line with the directory name."
9888aa65 953 (let ((opoint (point))
02b5d79c 954 (process-environment (copy-sequence process-environment))
9888aa65 955 end)
1fc85dae 956 (if (or dired-use-ls-dired (file-remote-p dir))
0b7bc76f 957 (setq switches (concat "--dired " switches)))
6492483f
RS
958 ;; We used to specify the C locale here, to force English month names;
959 ;; but this should not be necessary any more,
9bc260cf 960 ;; with the new value of `directory-listing-before-filename-regexp'.
0b7bc76f
RS
961 (if file-list
962 (dolist (f file-list)
a12c6dca
SM
963 (let ((beg (point)))
964 (insert-directory f switches nil nil)
965 ;; Re-align fields, if necessary.
966 (dired-align-file beg (point))))
0b7bc76f 967 (insert-directory dir switches wildcard (not wildcard)))
9888aa65 968 ;; Quote certain characters, unless ls quoted them for us.
ad632492
SM
969 (if (not (string-match "b" dired-actual-switches))
970 (save-excursion
971 (setq end (point-marker))
972 (goto-char opoint)
973 (while (search-forward "\\" end t)
2bb27597
AS
974 (replace-match (apply #'propertize
975 "\\\\"
976 (text-properties-at (match-beginning 0)))
977 nil t))
ad632492
SM
978 (goto-char opoint)
979 (while (search-forward "\^m" end t)
2bb27597
AS
980 (replace-match (apply #'propertize
981 "\\015"
982 (text-properties-at (match-beginning 0)))
983 nil t))
ad632492 984 (set-marker end nil)))
0b7bc76f
RS
985 (dired-insert-set-properties opoint (point))
986 ;; If we used --dired and it worked, the lines are already indented.
987 ;; Otherwise, indent them.
988 (unless (save-excursion
1ba6c0f2 989 (goto-char opoint)
0b7bc76f
RS
990 (looking-at " "))
991 (let ((indent-tabs-mode nil))
992 (indent-rigidly opoint (point) 2)))
993 ;; Insert text at the beginning to standardize things.
994 (save-excursion
995 (goto-char opoint)
996 (if (and (or hdr wildcard) (not (looking-at "^ /.*:$")))
997 ;; Note that dired-build-subdir-alist will replace the name
998 ;; by its expansion, so it does not matter whether what we insert
999 ;; here is fully expanded, but it should be absolute.
1000 (insert " " (directory-file-name (file-name-directory dir)) ":\n"))
1001 (when wildcard
1002 ;; Insert "wildcard" line where "total" line would be for a full dir.
1003 (insert " wildcard " (file-name-nondirectory dir) "\n")))))
492d2437 1004
cb88a3db 1005(defun dired-insert-set-properties (beg end)
d7aed37c 1006 "Make the file names highlight when the mouse is on them."
cb88a3db
RS
1007 (save-excursion
1008 (goto-char beg)
1009 (while (< (point) end)
7da0e9b4
RS
1010 (condition-case nil
1011 (if (dired-move-to-filename)
ac2d0299
EZ
1012 (add-text-properties
1013 (point)
1014 (save-excursion
1015 (dired-move-to-end-of-filename)
1016 (point))
1b85bd12 1017 '(mouse-face highlight
ac2d0299 1018 help-echo "mouse-2: visit this file in other window")))
7da0e9b4 1019 (error nil))
cb88a3db 1020 (forward-line 1))))
83fadedf 1021\f
492d2437
RS
1022;; Reverting a dired buffer
1023
84fc2cfa 1024(defun dired-revert (&optional arg noconfirm)
d7aed37c 1025 "Reread the dired buffer.
ee680b2b 1026Must also be called after `dired-actual-switches' have changed.
d7aed37c
SM
1027Should not fail even on completely garbaged buffers.
1028Preserves old cursor, marks/flags, hidden-p."
492d2437 1029 (widen) ; just in case user narrowed
7805cdbd
LT
1030 (let ((modflag (buffer-modified-p))
1031 (opoint (point))
492d2437
RS
1032 (ofile (dired-get-filename nil t))
1033 (mark-alist nil) ; save marked files
1034 (hidden-subdirs (dired-remember-hidden))
1035 (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
1036 (case-fold-search nil) ; we check for upper case ls flags
1037 buffer-read-only)
1038 (goto-char (point-min))
1039 (setq mark-alist;; only after dired-remember-hidden since this unhides:
1040 (dired-remember-marks (point-min) (point-max)))
1041 ;; treat top level dir extra (it may contain wildcards)
8d23c16b
ER
1042 (dired-uncache
1043 (if (consp dired-directory) (car dired-directory) dired-directory))
0b7bc76f 1044 (dired-readin)
492d2437
RS
1045 (let ((dired-after-readin-hook nil))
1046 ;; don't run that hook for each subdir...
1047 (dired-insert-old-subdirs old-subdir-alist))
1048 (dired-mark-remembered mark-alist) ; mark files that were marked
1049 ;; ... run the hook for the whole buffer, and only after markers
1050 ;; have been reinserted (else omitting in dired-x would omit marked files)
1051 (run-hooks 'dired-after-readin-hook) ; no need to narrow
1052 (or (and ofile (dired-goto-file ofile)) ; move cursor to where it
1053 (goto-char opoint)) ; was before
84fc2cfa 1054 (dired-move-to-filename)
492d2437 1055 (save-excursion ; hide subdirs that were hidden
d7aed37c
SM
1056 (dolist (dir hidden-subdirs)
1057 (if (dired-goto-subdir dir)
7805cdbd
LT
1058 (dired-hide-subdir 1))))
1059 (unless modflag (restore-buffer-modified-p nil)))
492d2437 1060 ;; outside of the let scope
7805cdbd 1061;;; Might as well not override the user if the user changed this.
492d2437
RS
1062;;; (setq buffer-read-only t)
1063 )
1064
1065;; Subroutines of dired-revert
1066;; Some of these are also used when inserting subdirs.
1067
1068(defun dired-remember-marks (beg end)
d7aed37c 1069 "Return alist of files and their marks, from BEG to END."
492d2437
RS
1070 (if selective-display ; must unhide to make this work.
1071 (let (buffer-read-only)
1072 (subst-char-in-region beg end ?\r ?\n)))
1073 (let (fil chr alist)
1074 (save-excursion
1075 (goto-char beg)
1076 (while (re-search-forward dired-re-mark end t)
1077 (if (setq fil (dired-get-filename nil t))
1078 (setq chr (preceding-char)
1079 alist (cons (cons fil chr) alist)))))
1080 alist))
1081
492d2437 1082(defun dired-mark-remembered (alist)
d7aed37c
SM
1083 "Mark all files remembered in ALIST.
1084Each element of ALIST looks like (FILE . MARKERCHAR)."
492d2437
RS
1085 (let (elt fil chr)
1086 (while alist
1087 (setq elt (car alist)
1088 alist (cdr alist)
1089 fil (car elt)
1090 chr (cdr elt))
1091 (if (dired-goto-file fil)
1092 (save-excursion
1093 (beginning-of-line)
1094 (delete-char 1)
1095 (insert chr))))))
1096
492d2437 1097(defun dired-remember-hidden ()
d7aed37c 1098 "Return a list of names of subdirs currently hidden."
492d2437
RS
1099 (let ((l dired-subdir-alist) dir pos result)
1100 (while l
1101 (setq dir (car (car l))
1102 pos (cdr (car l))
1103 l (cdr l))
1104 (goto-char pos)
1105 (skip-chars-forward "^\r\n")
52041219 1106 (if (eq (following-char) ?\r)
492d2437
RS
1107 (setq result (cons dir result))))
1108 result))
1109
492d2437 1110(defun dired-insert-old-subdirs (old-subdir-alist)
d7aed37c
SM
1111 "Try to insert all subdirs that were displayed before.
1112Do so according to the former subdir alist OLD-SUBDIR-ALIST."
492d2437
RS
1113 (or (string-match "R" dired-actual-switches)
1114 (let (elt dir)
1115 (while old-subdir-alist
1116 (setq elt (car old-subdir-alist)
1117 old-subdir-alist (cdr old-subdir-alist)
1118 dir (car elt))
1119 (condition-case ()
715984d3
RS
1120 (progn
1121 (dired-uncache dir)
f817c0fb 1122 (dired-insert-subdir dir))
492d2437 1123 (error nil))))))
715984d3 1124
715984d3 1125(defun dired-uncache (dir)
d7aed37c 1126 "Remove directory DIR from any directory cache."
6eaebaa2 1127 (let ((handler (find-file-name-handler dir 'dired-uncache)))
715984d3
RS
1128 (if handler
1129 (funcall handler 'dired-uncache dir))))
83fadedf 1130\f
492d2437 1131;; dired mode key bindings and initialization
84fc2cfa 1132
d7aed37c 1133(defvar dired-mode-map
492d2437
RS
1134 ;; This looks ugly when substitute-command-keys uses C-d instead d:
1135 ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
3e1fb00f
RS
1136 (let ((map (make-keymap)))
1137 (suppress-keymap map)
1138 (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
bb87fbc3 1139 (define-key map [follow-link] 'mouse-face)
3e1fb00f
RS
1140 ;; Commands to mark or flag certain categories of files
1141 (define-key map "#" 'dired-flag-auto-save-files)
3e1fb00f 1142 (define-key map "." 'dired-clean-directory)
3e1fb00f 1143 (define-key map "~" 'dired-flag-backup-files)
84d3f6e8 1144 (define-key map "&" 'dired-flag-garbage-files)
3e1fb00f
RS
1145 ;; Upper case keys (except !) for operating on the marked files
1146 (define-key map "A" 'dired-do-search)
1147 (define-key map "C" 'dired-do-copy)
1148 (define-key map "B" 'dired-do-byte-compile)
1149 (define-key map "D" 'dired-do-delete)
1150 (define-key map "G" 'dired-do-chgrp)
1151 (define-key map "H" 'dired-do-hardlink)
1152 (define-key map "L" 'dired-do-load)
1153 (define-key map "M" 'dired-do-chmod)
1154 (define-key map "O" 'dired-do-chown)
1155 (define-key map "P" 'dired-do-print)
ee93b692 1156 (define-key map "Q" 'dired-do-query-replace-regexp)
3e1fb00f
RS
1157 (define-key map "R" 'dired-do-rename)
1158 (define-key map "S" 'dired-do-symlink)
57654b8c 1159 (define-key map "T" 'dired-do-touch)
3e1fb00f
RS
1160 (define-key map "X" 'dired-do-shell-command)
1161 (define-key map "Z" 'dired-do-compress)
1162 (define-key map "!" 'dired-do-shell-command)
1163 ;; Comparison commands
1164 (define-key map "=" 'dired-diff)
1165 (define-key map "\M-=" 'dired-backup-diff)
1166 ;; Tree Dired commands
1167 (define-key map "\M-\C-?" 'dired-unmark-all-files)
1168 (define-key map "\M-\C-d" 'dired-tree-down)
1169 (define-key map "\M-\C-u" 'dired-tree-up)
1170 (define-key map "\M-\C-n" 'dired-next-subdir)
1171 (define-key map "\M-\C-p" 'dired-prev-subdir)
1172 ;; move to marked files
1173 (define-key map "\M-{" 'dired-prev-marked-file)
1174 (define-key map "\M-}" 'dired-next-marked-file)
1175 ;; Make all regexp commands share a `%' prefix:
1176 ;; We used to get to the submap via a symbol dired-regexp-prefix,
1177 ;; but that seems to serve little purpose, and copy-keymap
1178 ;; does a better job without it.
1179 (define-key map "%" nil)
1180 (define-key map "%u" 'dired-upcase)
1181 (define-key map "%l" 'dired-downcase)
1182 (define-key map "%d" 'dired-flag-files-regexp)
e9b8e22d 1183 (define-key map "%g" 'dired-mark-files-containing-regexp)
3e1fb00f
RS
1184 (define-key map "%m" 'dired-mark-files-regexp)
1185 (define-key map "%r" 'dired-do-rename-regexp)
1186 (define-key map "%C" 'dired-do-copy-regexp)
1187 (define-key map "%H" 'dired-do-hardlink-regexp)
1188 (define-key map "%R" 'dired-do-rename-regexp)
1189 (define-key map "%S" 'dired-do-symlink-regexp)
4a3ca6ed
RS
1190 ;; Commands for marking and unmarking.
1191 (define-key map "*" nil)
1192 (define-key map "**" 'dired-mark-executables)
1193 (define-key map "*/" 'dired-mark-directories)
1194 (define-key map "*@" 'dired-mark-symlinks)
1195 (define-key map "*%" 'dired-mark-files-regexp)
1196 (define-key map "*c" 'dired-change-marks)
0609c998 1197 (define-key map "*s" 'dired-mark-subdir-files)
4a3ca6ed
RS
1198 (define-key map "*m" 'dired-mark)
1199 (define-key map "*u" 'dired-unmark)
1200 (define-key map "*?" 'dired-unmark-all-files)
534a6edf 1201 (define-key map "*!" 'dired-unmark-all-marks)
d7aed37c 1202 (define-key map "U" 'dired-unmark-all-marks)
4a3ca6ed
RS
1203 (define-key map "*\177" 'dired-unmark-backward)
1204 (define-key map "*\C-n" 'dired-next-marked-file)
1205 (define-key map "*\C-p" 'dired-prev-marked-file)
d588eb90 1206 (define-key map "*t" 'dired-toggle-marks)
3e1fb00f 1207 ;; Lower keys for commands not operating on all the marked files
c5753a5d 1208 (define-key map "a" 'dired-find-alternate-file)
3e1fb00f
RS
1209 (define-key map "d" 'dired-flag-file-deletion)
1210 (define-key map "e" 'dired-find-file)
1211 (define-key map "f" 'dired-find-file)
1212 (define-key map "\C-m" 'dired-advertised-find-file)
1213 (define-key map "g" 'revert-buffer)
e906b0a2 1214 (define-key map "\M-g" 'dired-goto-file)
3e1fb00f
RS
1215 (define-key map "h" 'describe-mode)
1216 (define-key map "i" 'dired-maybe-insert-subdir)
1217 (define-key map "k" 'dired-do-kill-lines)
1218 (define-key map "l" 'dired-do-redisplay)
1219 (define-key map "m" 'dired-mark)
1220 (define-key map "n" 'dired-next-line)
1221 (define-key map "o" 'dired-find-file-other-window)
1222 (define-key map "\C-o" 'dired-display-file)
1223 (define-key map "p" 'dired-previous-line)
da8a8438 1224 (define-key map "q" 'quit-window)
3e1fb00f 1225 (define-key map "s" 'dired-sort-toggle-or-edit)
d588eb90 1226 (define-key map "t" 'dired-toggle-marks)
3e1fb00f
RS
1227 (define-key map "u" 'dired-unmark)
1228 (define-key map "v" 'dired-view-file)
a3f4a3ef 1229 (define-key map "w" 'dired-copy-filename-as-kill)
3e1fb00f 1230 (define-key map "x" 'dired-do-flagged-delete)
d1e99fa5 1231 (define-key map "y" 'dired-show-file-type)
3e1fb00f
RS
1232 (define-key map "+" 'dired-create-directory)
1233 ;; moving
1234 (define-key map "<" 'dired-prev-dirline)
1235 (define-key map ">" 'dired-next-dirline)
1236 (define-key map "^" 'dired-up-directory)
1237 (define-key map " " 'dired-next-line)
1238 (define-key map "\C-n" 'dired-next-line)
1239 (define-key map "\C-p" 'dired-previous-line)
1240 (define-key map [down] 'dired-next-line)
1241 (define-key map [up] 'dired-previous-line)
1242 ;; hiding
1243 (define-key map "$" 'dired-hide-subdir)
1244 (define-key map "\M-$" 'dired-hide-all)
1245 ;; misc
1246 (define-key map "?" 'dired-summary)
1247 (define-key map "\177" 'dired-unmark-backward)
5e5a3412
RS
1248 (define-key map [remap undo] 'dired-undo)
1249 (define-key map [remap advertised-undo] 'dired-undo)
a2c40109
MD
1250 ;; thumbnail manipulation (tumme)
1251 (define-key map "\C-td" 'tumme-display-thumbs)
6102da26
MD
1252 (define-key map "\C-tt" 'tumme-tag-files)
1253 (define-key map "\C-tr" 'tumme-tag-remove)
1254 (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer)
1255 (define-key map "\C-ti" 'tumme-display-dired-image)
1256 (define-key map "\C-tx" 'tumme-dired-display-external)
1257 (define-key map "\C-ta" 'tumme-display-thumbs-append)
1258 (define-key map "\C-t." 'tumme-display-thumb)
1259 (define-key map "\C-tc" 'tumme-dired-comment-files)
1260 (define-key map "\C-tf" 'tumme-mark-tagged-files)
ea948bd6 1261 (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs)
3e1fb00f
RS
1262
1263 ;; Make menu bar items.
1264
d066de8e
EZ
1265 ;; No need to fo this, now that top-level items are fewer.
1266 ;;;;
3e1fb00f 1267 ;; Get rid of the Edit menu bar item to save space.
d066de8e 1268 ;(define-key map [menu-bar edit] 'undefined)
3e1fb00f
RS
1269
1270 (define-key map [menu-bar subdir]
1271 (cons "Subdir" (make-sparse-keymap "Subdir")))
1272
1273 (define-key map [menu-bar subdir hide-all]
d066de8e
EZ
1274 '(menu-item "Hide All" dired-hide-all
1275 :help "Hide all subdirectories, leave only header lines"))
3e1fb00f 1276 (define-key map [menu-bar subdir hide-subdir]
d066de8e
EZ
1277 '(menu-item "Hide/UnHide Subdir" dired-hide-subdir
1278 :help "Hide or unhide current directory listing"))
3e1fb00f 1279 (define-key map [menu-bar subdir tree-down]
d066de8e
EZ
1280 '(menu-item "Tree Down" dired-tree-down
1281 :help "Go to first subdirectory header down the tree"))
3e1fb00f 1282 (define-key map [menu-bar subdir tree-up]
d066de8e
EZ
1283 '(menu-item "Tree Up" dired-tree-up
1284 :help "Go to first subdirectory header up the tree"))
3e1fb00f 1285 (define-key map [menu-bar subdir up]
d066de8e
EZ
1286 '(menu-item "Up Directory" dired-up-directory
1287 :help "Edit the parent directory"))
3e1fb00f 1288 (define-key map [menu-bar subdir prev-subdir]
d066de8e
EZ
1289 '(menu-item "Prev Subdir" dired-prev-subdir
1290 :help "Go to previous subdirectory header line"))
3e1fb00f 1291 (define-key map [menu-bar subdir next-subdir]
d066de8e
EZ
1292 '(menu-item "Next Subdir" dired-next-subdir
1293 :help "Go to next subdirectory header line"))
3e1fb00f 1294 (define-key map [menu-bar subdir prev-dirline]
d066de8e
EZ
1295 '(menu-item "Prev Dirline" dired-prev-dirline
1296 :help "Move to next directory-file line"))
3e1fb00f 1297 (define-key map [menu-bar subdir next-dirline]
d066de8e
EZ
1298 '(menu-item "Next Dirline" dired-next-dirline
1299 :help "Move to previous directory-file line"))
3e1fb00f 1300 (define-key map [menu-bar subdir insert]
d066de8e
EZ
1301 '(menu-item "Insert This Subdir" dired-maybe-insert-subdir
1302 :help "Insert contents of subdirectory"))
3e1fb00f
RS
1303
1304 (define-key map [menu-bar immediate]
1305 (cons "Immediate" (make-sparse-keymap "Immediate")))
1306
a3285795 1307 (define-key map [menu-bar immediate revert-buffer]
d066de8e
EZ
1308 '(menu-item "Refresh" revert-buffer
1309 :help "Update contents of shown directories"))
a3285795
RS
1310
1311 (define-key map [menu-bar immediate dashes]
1312 '("--"))
1313
0e2aaf98 1314 (define-key map [menu-bar immediate compare-directories]
11782fd6 1315 '(menu-item "Compare directories..." dired-compare-directories
0e2aaf98 1316 :help "Mark files with different attributes in two dired buffers"))
3e1fb00f 1317 (define-key map [menu-bar immediate backup-diff]
d066de8e
EZ
1318 '(menu-item "Compare with Backup" dired-backup-diff
1319 :help "Diff file at cursor with its latest backup"))
3e1fb00f 1320 (define-key map [menu-bar immediate diff]
d066de8e
EZ
1321 '(menu-item "Diff..." dired-diff
1322 :help "Compare file at cursor with another file"))
3e1fb00f 1323 (define-key map [menu-bar immediate view]
d066de8e
EZ
1324 '(menu-item "View This File" dired-view-file
1325 :help "Examine file at cursor in read-only mode"))
3e1fb00f 1326 (define-key map [menu-bar immediate display]
d066de8e
EZ
1327 '(menu-item "Display in Other Window" dired-display-file
1328 :help "Display file at cursor in other window"))
3e1fb00f 1329 (define-key map [menu-bar immediate find-file-other-window]
d066de8e
EZ
1330 '(menu-item "Find in Other Window" dired-find-file-other-window
1331 :help "Edit file at cursor in other window"))
3e1fb00f 1332 (define-key map [menu-bar immediate find-file]
d066de8e
EZ
1333 '(menu-item "Find This File" dired-find-file
1334 :help "Edit file at cursor"))
3e1fb00f 1335 (define-key map [menu-bar immediate create-directory]
d066de8e 1336 '(menu-item "Create Directory..." dired-create-directory))
2ecab840
SM
1337 (define-key map [menu-bar immediate wdired-mode]
1338 '(menu-item "Edit File Names" wdired-change-to-wdired-mode))
3e1fb00f
RS
1339
1340 (define-key map [menu-bar regexp]
1341 (cons "Regexp" (make-sparse-keymap "Regexp")))
1342
1343 (define-key map [menu-bar regexp downcase]
d066de8e
EZ
1344 '(menu-item "Downcase" dired-downcase
1345 ;; When running on plain MS-DOS, there's only one
1346 ;; letter-case for file names.
1347 :enable (or (not (fboundp 'msdos-long-file-names))
1348 (msdos-long-file-names))
1349 :help "Rename marked files to lower-case name"))
3e1fb00f 1350 (define-key map [menu-bar regexp upcase]
d066de8e
EZ
1351 '(menu-item "Upcase" dired-upcase
1352 :enable (or (not (fboundp 'msdos-long-file-names))
1353 (msdos-long-file-names))
1354 :help "Rename marked files to upper-case name"))
3e1fb00f 1355 (define-key map [menu-bar regexp hardlink]
d066de8e
EZ
1356 '(menu-item "Hardlink..." dired-do-hardlink-regexp
1357 :help "Make hard links for files matching regexp"))
3e1fb00f 1358 (define-key map [menu-bar regexp symlink]
d066de8e
EZ
1359 '(menu-item "Symlink..." dired-do-symlink-regexp
1360 :visible (fboundp 'make-symbolic-link)
1361 :help "Make symbolic links for files matching regexp"))
3e1fb00f 1362 (define-key map [menu-bar regexp rename]
d066de8e
EZ
1363 '(menu-item "Rename..." dired-do-rename-regexp
1364 :help "Rename marked files matching regexp"))
3e1fb00f 1365 (define-key map [menu-bar regexp copy]
d066de8e
EZ
1366 '(menu-item "Copy..." dired-do-copy-regexp
1367 :help "Copy marked files matching regexp"))
3e1fb00f 1368 (define-key map [menu-bar regexp flag]
d066de8e
EZ
1369 '(menu-item "Flag..." dired-flag-files-regexp
1370 :help "Flag files matching regexp for deletion"))
3e1fb00f 1371 (define-key map [menu-bar regexp mark]
d066de8e
EZ
1372 '(menu-item "Mark..." dired-mark-files-regexp
1373 :help "Mark files matching regexp for future operations"))
aa924deb 1374 (define-key map [menu-bar regexp mark-cont]
d066de8e
EZ
1375 '(menu-item "Mark Containing..." dired-mark-files-containing-regexp
1376 :help "Mark files whose contents matches regexp"))
3e1fb00f
RS
1377
1378 (define-key map [menu-bar mark]
1379 (cons "Mark" (make-sparse-keymap "Mark")))
1380
1381 (define-key map [menu-bar mark prev]
d066de8e
EZ
1382 '(menu-item "Previous Marked" dired-prev-marked-file
1383 :help "Move to previous marked file"))
3e1fb00f 1384 (define-key map [menu-bar mark next]
d066de8e
EZ
1385 '(menu-item "Next Marked" dired-next-marked-file
1386 :help "Move to next marked file"))
3e1fb00f 1387 (define-key map [menu-bar mark marks]
d066de8e
EZ
1388 '(menu-item "Change Marks..." dired-change-marks
1389 :help "Replace marker with another character"))
3e1fb00f 1390 (define-key map [menu-bar mark unmark-all]
d066de8e 1391 '(menu-item "Unmark All" dired-unmark-all-marks))
3e1fb00f 1392 (define-key map [menu-bar mark symlinks]
d066de8e
EZ
1393 '(menu-item "Mark Symlinks" dired-mark-symlinks
1394 :visible (fboundp 'make-symbolic-link)
1395 :help "Mark all symbolic links"))
3e1fb00f 1396 (define-key map [menu-bar mark directories]
d066de8e
EZ
1397 '(menu-item "Mark Directories" dired-mark-directories
1398 :help "Mark all directories except `.' and `..'"))
3e1fb00f 1399 (define-key map [menu-bar mark directory]
d066de8e
EZ
1400 '(menu-item "Mark Old Backups" dired-clean-directory
1401 :help "Flag old numbered backups for deletion"))
3e1fb00f 1402 (define-key map [menu-bar mark executables]
d066de8e
EZ
1403 '(menu-item "Mark Executables" dired-mark-executables
1404 :help "Mark all executable files"))
84d3f6e8 1405 (define-key map [menu-bar mark garbage-files]
d066de8e
EZ
1406 '(menu-item "Flag Garbage Files" dired-flag-garbage-files
1407 :help "Flag unneeded files for deletion"))
3e1fb00f 1408 (define-key map [menu-bar mark backup-files]
d066de8e
EZ
1409 '(menu-item "Flag Backup Files" dired-flag-backup-files
1410 :help "Flag all backup files for deletion"))
3e1fb00f 1411 (define-key map [menu-bar mark auto-save-files]
d066de8e
EZ
1412 '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
1413 :help "Flag auto-save files for deletion"))
3e1fb00f 1414 (define-key map [menu-bar mark deletion]
d066de8e
EZ
1415 '(menu-item "Flag" dired-flag-file-deletion
1416 :help "Flag current line's file for deletion"))
3e1fb00f 1417 (define-key map [menu-bar mark unmark]
d066de8e
EZ
1418 '(menu-item "Unmark" dired-unmark
1419 :help "Unmark or unflag current line's file"))
3e1fb00f 1420 (define-key map [menu-bar mark mark]
d066de8e
EZ
1421 '(menu-item "Mark" dired-mark
1422 :help "Mark current line's file for future operations"))
e5f0841e 1423 (define-key map [menu-bar mark toggle-marks]
d588eb90 1424 '(menu-item "Toggle Marks" dired-toggle-marks
d066de8e 1425 :help "Mark unmarked files, unmark marked ones"))
3e1fb00f
RS
1426
1427 (define-key map [menu-bar operate]
1428 (cons "Operate" (make-sparse-keymap "Operate")))
1429
1430 (define-key map [menu-bar operate query-replace]
ee93b692 1431 '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp
d066de8e 1432 :help "Replace regexp in marked files"))
3e1fb00f 1433 (define-key map [menu-bar operate search]
d066de8e
EZ
1434 '(menu-item "Search Files..." dired-do-search
1435 :help "Search marked files for regexp"))
3e1fb00f 1436 (define-key map [menu-bar operate chown]
d066de8e
EZ
1437 '(menu-item "Change Owner..." dired-do-chown
1438 :visible (not (memq system-type '(ms-dos windows-nt)))
1439 :help "Change the owner of marked files"))
3e1fb00f 1440 (define-key map [menu-bar operate chgrp]
d066de8e
EZ
1441 '(menu-item "Change Group..." dired-do-chgrp
1442 :visible (not (memq system-type '(ms-dos windows-nt)))
1443 :help "Change the group of marked files"))
3e1fb00f 1444 (define-key map [menu-bar operate chmod]
d066de8e
EZ
1445 '(menu-item "Change Mode..." dired-do-chmod
1446 :help "Change mode (attributes) of marked files"))
57654b8c
JL
1447 (define-key map [menu-bar operate touch]
1448 '(menu-item "Change Timestamp..." dired-do-touch
1449 :help "Change timestamp of marked files"))
3e1fb00f 1450 (define-key map [menu-bar operate load]
d066de8e
EZ
1451 '(menu-item "Load" dired-do-load
1452 :help "Load marked Emacs Lisp files"))
3e1fb00f 1453 (define-key map [menu-bar operate compile]
d066de8e
EZ
1454 '(menu-item "Byte-compile" dired-do-byte-compile
1455 :help "Byte-compile marked Emacs Lisp files"))
3e1fb00f 1456 (define-key map [menu-bar operate compress]
d066de8e
EZ
1457 '(menu-item "Compress" dired-do-compress
1458 :help "Compress/uncompress marked files"))
3e1fb00f 1459 (define-key map [menu-bar operate print]
d066de8e
EZ
1460 '(menu-item "Print..." dired-do-print
1461 :help "Ask for print command and print marked files"))
3e1fb00f 1462 (define-key map [menu-bar operate hardlink]
d066de8e
EZ
1463 '(menu-item "Hardlink to..." dired-do-hardlink
1464 :help "Make hard links for current or marked files"))
3e1fb00f 1465 (define-key map [menu-bar operate symlink]
d066de8e
EZ
1466 '(menu-item "Symlink to..." dired-do-symlink
1467 :visible (fboundp 'make-symbolic-link)
1468 :help "Make symbolic links for current or marked files"))
3e1fb00f 1469 (define-key map [menu-bar operate command]
d066de8e
EZ
1470 '(menu-item "Shell Command..." dired-do-shell-command
1471 :help "Run a shell command on each of marked files"))
3e1fb00f 1472 (define-key map [menu-bar operate delete]
d066de8e
EZ
1473 '(menu-item "Delete" dired-do-delete
1474 :help "Delete current file or all marked files"))
3e1fb00f 1475 (define-key map [menu-bar operate rename]
d066de8e
EZ
1476 '(menu-item "Rename to..." dired-do-rename
1477 :help "Rename current file or move marked files"))
3e1fb00f 1478 (define-key map [menu-bar operate copy]
d066de8e
EZ
1479 '(menu-item "Copy to..." dired-do-copy
1480 :help "Copy current file or all marked files"))
3e1fb00f 1481
d7aed37c
SM
1482 map)
1483 "Local keymap for `dired-mode' buffers.")
83fadedf 1484\f
84fc2cfa
ER
1485;; Dired mode is suitable only for specially formatted data.
1486(put 'dired-mode 'mode-class 'special)
1487
a515788d
LH
1488;; Autoload cookie needed by desktop.el
1489;;;###autoload
492d2437
RS
1490(defun dired-mode (&optional dirname switches)
1491 "\
1492Mode for \"editing\" directory listings.
68d2f12f 1493In Dired, you are \"editing\" a list of the files in a directory and
492d2437
RS
1494 \(optionally) its subdirectories, in the format of `ls -lR'.
1495 Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
1496\"Editing\" means that you can run shell commands on files, visit,
1497 compress, load or byte-compile them, change their file attributes
1498 and insert subdirectories into the same buffer. You can \"mark\"
1499 files for later commands or \"flag\" them for deletion, either file
1500 by file or all files matching certain criteria.
1501You can move using the usual cursor motion commands.\\<dired-mode-map>
1502Letters no longer insert themselves. Digits are prefix arguments.
1503Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion.
1504Type \\[dired-mark] to Mark a file or subdirectory for later commands.
1505 Most commands operate on the marked files and use the current file
1506 if no files are marked. Use a numeric prefix argument to operate on
1507 the next ARG (or previous -ARG if ARG<0) files, or just `1'
1508 to operate on the current file only. Prefix arguments override marks.
1509 Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
1510 to see why something went wrong.
1511Type \\[dired-unmark] to Unmark a file or all files of a subdirectory.
1512Type \\[dired-unmark-backward] to back up one line and unflag.
1513Type \\[dired-do-flagged-delete] to eXecute the deletions requested.
1514Type \\[dired-advertised-find-file] to Find the current line's file
1515 (or dired it in another buffer, if it is a directory).
1516Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
1517Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
1518Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
1519Type \\[dired-do-copy] to Copy files.
ee680b2b
JB
1520Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
1521Type \\[revert-buffer] to read all currently expanded directories aGain.
492d2437
RS
1522 This retains all marks and hides subdirs again that were hidden before.
1523SPC and DEL can be used to move down and up by lines.
1524
ee680b2b 1525If Dired ever gets confused, you can either type \\[revert-buffer] \
492d2437
RS
1526to read the
1527directories again, type \\[dired-do-redisplay] \
1528to relist a single or the marked files or a
1529subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
1530again for the directory tree.
1531
1532Customization variables (rename this buffer and type \\[describe-variable] on each line
1533for more info):
1534
87ae59e3
SM
1535 `dired-listing-switches'
1536 `dired-trivial-filenames'
1537 `dired-shrink-to-fit'
1538 `dired-marker-char'
1539 `dired-del-marker'
1540 `dired-keep-marker-rename'
1541 `dired-keep-marker-copy'
1542 `dired-keep-marker-hardlink'
1543 `dired-keep-marker-symlink'
492d2437
RS
1544
1545Hooks (use \\[describe-variable] to see their documentation):
1546
87ae59e3
SM
1547 `dired-before-readin-hook'
1548 `dired-after-readin-hook'
1549 `dired-mode-hook'
1550 `dired-load-hook'
492d2437
RS
1551
1552Keybindings:
84fc2cfa 1553\\{dired-mode-map}"
492d2437
RS
1554 ;; Not to be called interactively (e.g. dired-directory will be set
1555 ;; to default-directory, which is wrong with wildcards).
84fc2cfa 1556 (kill-all-local-variables)
84fc2cfa 1557 (use-local-map dired-mode-map)
492d2437
RS
1558 (dired-advertise) ; default-directory is already set
1559 (setq major-mode 'dired-mode
1560 mode-name "Dired"
87ae59e3 1561 ;; case-fold-search nil
492d2437
RS
1562 buffer-read-only t
1563 selective-display t ; for subdirectory hiding
0acdf642
GM
1564 mode-line-buffer-identification
1565 (propertized-buffer-identification "%17b"))
492d2437
RS
1566 (set (make-local-variable 'revert-buffer-function)
1567 (function dired-revert))
573e4d2d
LT
1568 (set (make-local-variable 'buffer-stale-function)
1569 (function dired-buffer-stale-p))
492d2437
RS
1570 (set (make-local-variable 'page-delimiter)
1571 "\n\n")
1572 (set (make-local-variable 'dired-directory)
1573 (or dirname default-directory))
1574 ;; list-buffers uses this to display the dir being edited in this buffer.
1575 (set (make-local-variable 'list-buffers-directory)
86e6e4b3
RS
1576 (expand-file-name (if (listp dired-directory)
1577 (car dired-directory)
1578 dired-directory)))
492d2437
RS
1579 (set (make-local-variable 'dired-actual-switches)
1580 (or switches dired-listing-switches))
d7aed37c
SM
1581 (set (make-local-variable 'font-lock-defaults)
1582 '(dired-font-lock-keywords t nil nil beginning-of-line))
cb5f1f67 1583 (set (make-local-variable 'desktop-save-buffer)
31b4c848 1584 'dired-desktop-buffer-misc-data)
5553077c 1585 (setq dired-switches-alist nil)
492d2437 1586 (dired-sort-other dired-actual-switches t)
361eee8f 1587 (when (featurep 'dnd)
6ae53dc1
RS
1588 (set (make-local-variable 'dnd-protocol-alist)
1589 (append dired-dnd-protocol-alist dnd-protocol-alist)))
1ed8284d 1590 (run-mode-hooks 'dired-mode-hook))
83fadedf 1591\f
eb8c3be9 1592;; Idiosyncratic dired commands that don't deal with marks.
84fc2cfa 1593
84fc2cfa 1594(defun dired-summary ()
ee680b2b 1595 "Summarize basic Dired commands and show recent dired errors."
84fc2cfa 1596 (interactive)
492d2437 1597 (dired-why)
84fc2cfa
ER
1598 ;>> this should check the key-bindings and use substitute-command-keys if non-standard
1599 (message
50f74744 1600 "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
84fc2cfa 1601
492d2437
RS
1602(defun dired-undo ()
1603 "Undo in a dired buffer.
1604This doesn't recover lost files, it just undoes changes in the buffer itself.
487327a9 1605You can use it to recover marks, killed lines or subdirs."
492d2437
RS
1606 (interactive)
1607 (let (buffer-read-only)
487327a9
LT
1608 (undo))
1609 (dired-build-subdir-alist)
ee680b2b 1610 (message "Change in dired buffer undone.
487327a9 1611Actual changes in files cannot be undone by Emacs."))
84fc2cfa
ER
1612
1613(defun dired-next-line (arg)
1614 "Move down lines then position at filename.
1615Optional prefix ARG says how many lines to move; default is one line."
1616 (interactive "p")
1617 (next-line arg)
1618 (dired-move-to-filename))
1619
1620(defun dired-previous-line (arg)
1621 "Move up lines then position at filename.
1622Optional prefix ARG says how many lines to move; default is one line."
1623 (interactive "p")
1624 (previous-line arg)
1625 (dired-move-to-filename))
1626
492d2437
RS
1627(defun dired-next-dirline (arg &optional opoint)
1628 "Goto ARG'th next directory file line."
1629 (interactive "p")
1630 (or opoint (setq opoint (point)))
1631 (if (if (> arg 0)
1632 (re-search-forward dired-re-dir nil t arg)
1633 (beginning-of-line)
1634 (re-search-backward dired-re-dir nil t (- arg)))
1635 (dired-move-to-filename) ; user may type `i' or `f'
1636 (goto-char opoint)
1637 (error "No more subdirectories")))
1638
1639(defun dired-prev-dirline (arg)
1640 "Goto ARG'th previous directory file line."
1641 (interactive "p")
1642 (dired-next-dirline (- arg)))
1643
ac1ce341 1644(defun dired-up-directory (&optional other-window)
68d2f12f 1645 "Run Dired on parent directory of current directory.
492d2437
RS
1646Find the parent directory either in this buffer or another buffer.
1647Creates a buffer if necessary."
ac1ce341 1648 (interactive "P")
492d2437
RS
1649 (let* ((dir (dired-current-directory))
1650 (up (file-name-directory (directory-file-name dir))))
1651 (or (dired-goto-file (directory-file-name dir))
7b2469ae
RS
1652 ;; Only try dired-goto-subdir if buffer has more than one dir.
1653 (and (cdr dired-subdir-alist)
492d2437
RS
1654 (dired-goto-subdir up))
1655 (progn
ac1ce341
EN
1656 (if other-window
1657 (dired-other-window up)
1658 (dired up))
492d2437 1659 (dired-goto-file dir)))))
84fc2cfa 1660
68d2f12f
RS
1661(defun dired-get-file-for-visit ()
1662 "Get the current line's file name, with an error if file does not exist."
53fd9d05 1663 (interactive)
e9407052
RS
1664 ;; We pass t for second arg so that we don't get error for `.' and `..'.
1665 (let ((raw (dired-get-filename nil t))
1666 file-name)
1667 (if (null raw)
1668 (error "No file on this line"))
1669 (setq file-name (file-name-sans-versions raw t))
c439687b 1670 (if (file-exists-p file-name)
68d2f12f 1671 file-name
55642aa4
RS
1672 (if (file-symlink-p file-name)
1673 (error "File is a symlink to a nonexistent target")
ee680b2b 1674 (error "File no longer exists; type `g' to update dired buffer")))))
84fc2cfa 1675
68d2f12f
RS
1676;; Force `f' rather than `e' in the mode doc:
1677(defalias 'dired-advertised-find-file 'dired-find-file)
1678(defun dired-find-file ()
1679 "In Dired, visit the file or directory named on this line."
1680 (interactive)
1d5ad120 1681 ;; Bind `find-file-run-dired' so that the command works on directories
59d18288
RS
1682 ;; too, independent of the user's setting.
1683 (let ((find-file-run-dired t))
1684 (find-file (dired-get-file-for-visit))))
68d2f12f 1685
c5753a5d 1686(defun dired-find-alternate-file ()
68d2f12f 1687 "In Dired, visit this file or directory instead of the dired buffer."
c5753a5d
GM
1688 (interactive)
1689 (set-buffer-modified-p nil)
68d2f12f 1690 (find-alternate-file (dired-get-file-for-visit)))
336cd99d 1691;; Don't override the setting from .emacs.
c21993d0 1692;;;###autoload (put 'dired-find-alternate-file 'disabled t)
c5753a5d 1693
dbcb9389 1694(defun dired-mouse-find-file-other-window (event)
68d2f12f 1695 "In Dired, visit the file or directory name you click on."
dbcb9389 1696 (interactive "e")
2aaa7f0a 1697 (let (window pos file)
dbcb9389 1698 (save-excursion
2aaa7f0a
RS
1699 (setq window (posn-window (event-end event))
1700 pos (posn-point (event-end event)))
1701 (if (not (windowp window))
1702 (error "No file chosen"))
1703 (set-buffer (window-buffer window))
1704 (goto-char pos)
1705 (setq file (dired-get-file-for-visit)))
55a87770
RS
1706 (if (file-directory-p file)
1707 (or (and (cdr dired-subdir-alist)
1708 (dired-goto-subdir file))
1709 (progn
1710 (select-window window)
1711 (dired-other-window file)))
3f68d7c8
RS
1712 (select-window window)
1713 (find-file-other-window (file-name-sans-versions file t)))))
b70ebe37 1714
84fc2cfa 1715(defun dired-view-file ()
ee680b2b 1716 "In Dired, examine a file in view mode, returning to Dired when done.
b70ebe37 1717When file is a directory, show it in this buffer if it is inserted.
3f68d7c8 1718Otherwise, display it in another buffer."
84fc2cfa 1719 (interactive)
68d2f12f
RS
1720 (let ((file (dired-get-file-for-visit)))
1721 (if (file-directory-p file)
1722 (or (and (cdr dired-subdir-alist)
1723 (dired-goto-subdir file))
1724 (dired file))
3f68d7c8 1725 (view-file file))))
84fc2cfa
ER
1726
1727(defun dired-find-file-other-window ()
68d2f12f 1728 "In Dired, visit this file or directory in another window."
84fc2cfa 1729 (interactive)
68d2f12f 1730 (find-file-other-window (dired-get-file-for-visit)))
ab67260b
RS
1731
1732(defun dired-display-file ()
68d2f12f 1733 "In Dired, display this file or directory in another window."
ab67260b 1734 (interactive)
68d2f12f 1735 (display-buffer (find-file-noselect (dired-get-file-for-visit))))
83fadedf 1736\f
68d2f12f 1737;;; Functions for extracting and manipulating file names in Dired buffers.
84fc2cfa
ER
1738
1739(defun dired-get-filename (&optional localp no-error-if-not-filep)
68d2f12f 1740 "In Dired, return name of file mentioned on this line.
84fc2cfa 1741Value returned normally includes the directory name.
492d2437 1742Optional arg LOCALP with value `no-dir' means don't include directory
147e214c
LT
1743name in result. A value of `verbatim' means to return the name exactly as
1744it occurs in the buffer, and a value of t means construct name relative to
1745`default-directory', which still may contain slashes if in a subdirectory.
1746Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
1747regular filenames and return nil if no filename on this line.
1748Otherwise, an error occurs in these cases."
a5e0e1a8 1749 (let (case-fold-search file p1 p2 already-absolute)
84fc2cfa 1750 (save-excursion
492d2437
RS
1751 (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
1752 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
1753 ;; nil if no file on this line, but no-error-if-not-filep is t:
9888aa65
RS
1754 (if (setq file (and p1 p2 (buffer-substring p1 p2)))
1755 (progn
1756 ;; Get rid of the mouse-face property that file names have.
1757 (set-text-properties 0 (length file) nil file)
1758 ;; Unquote names quoted by ls or by dired-insert-directory.
1759 ;; Using read to unquote is much faster than substituting
1760 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
1761 (setq file
1762 (read
1763 (concat "\""
2b2059d8 1764 ;; Some ls -b don't escape quotes, argh!
9888aa65
RS
1765 ;; This is not needed for GNU ls, though.
1766 (or (dired-string-replace-match
bc07e5cb 1767 "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
9888aa65 1768 file)
038b5501
KH
1769 "\"")))
1770 ;; The above `read' will return a unibyte string if FILE
1771 ;; contains eight-bit-control/graphic characters.
1772 (if (and enable-multibyte-characters
1773 (not (multibyte-string-p file)))
1774 (setq file (string-to-multibyte file)))))
f6e2cbe3 1775 (and file (file-name-absolute-p file)
7994d91a
RS
1776 ;; A relative file name can start with ~.
1777 ;; Don't treat it as absolute in this context.
1778 (not (eq (aref file 0) ?~))
a5e0e1a8 1779 (setq already-absolute t))
a5e0e1a8 1780 (cond
b95ddab3
RS
1781 ((null file)
1782 nil)
1d5ad120
JB
1783 ((eq localp 'verbatim)
1784 file)
e9407052 1785 ((and (not no-error-if-not-filep)
5709c1a0 1786 (member file '("." "..")))
e9407052 1787 (error "Cannot operate on `.' or `..'"))
a5e0e1a8
EZ
1788 ((and (eq localp 'no-dir) already-absolute)
1789 (file-name-nondirectory file))
b95ddab3 1790 (already-absolute
ca66efd1
RS
1791 (let ((handler (find-file-name-handler file nil)))
1792 ;; check for safe-magic property so that we won't
1793 ;; put /: for names that don't really need them.
0b7bc76f 1794 ;; For instance, .gz files when auto-compression-mode is on.
ca66efd1
RS
1795 (if (and handler (not (get handler 'safe-magic)))
1796 (concat "/:" file)
1797 file)))
b95ddab3 1798 ((eq localp 'no-dir)
a5e0e1a8 1799 file)
b95ddab3
RS
1800 ((equal (dired-current-directory) "/")
1801 (setq file (concat (dired-current-directory localp) file))
ca66efd1
RS
1802 (let ((handler (find-file-name-handler file nil)))
1803 ;; check for safe-magic property so that we won't
1804 ;; put /: for names that don't really need them.
1805 ;; For instance, .gz files when auto-compression-mode is on.
1806 (if (and handler (not (get handler 'safe-magic)))
1807 (concat "/:" file)
1808 file)))
a5e0e1a8 1809 (t
b95ddab3 1810 (concat (dired-current-directory localp) file)))))
492d2437 1811
437fe5ae 1812(defun dired-string-replace-match (regexp string newtext
1d5ad120 1813 &optional literal global)
437fe5ae
RS
1814 "Replace first match of REGEXP in STRING with NEWTEXT.
1815If it does not match, nil is returned instead of the new string.
1816Optional arg LITERAL means to take NEWTEXT literally.
1817Optional arg GLOBAL means to replace all matches."
1818 (if global
b976e099 1819 (let ((start 0) ret)
856321e2
RS
1820 (while (string-match regexp string start)
1821 (let ((from-end (- (length string) (match-end 0))))
b976e099 1822 (setq ret (setq string (replace-match newtext t literal string)))
856321e2 1823 (setq start (- (length string) from-end))))
b976e099 1824 ret)
437fe5ae
RS
1825 (if (not (string-match regexp string 0))
1826 nil
856321e2 1827 (replace-match newtext t literal string))))
437fe5ae 1828
492d2437 1829(defun dired-make-absolute (file &optional dir)
470fa6d1 1830 ;;"Convert FILE (a file name relative to DIR) to an absolute file name."
492d2437
RS
1831 ;; We can't always use expand-file-name as this would get rid of `.'
1832 ;; or expand in / instead default-directory if DIR=="".
1833 ;; This should be good enough for ange-ftp, but might easily be
1834 ;; redefined (for VMS?).
1835 ;; It should be reasonably fast, though, as it is called in
1836 ;; dired-get-filename.
1837 (concat (or dir default-directory) file))
1838
827dc60d
RS
1839(defun dired-make-relative (file &optional dir ignore)
1840 "Convert FILE (an absolute file name) to a name relative to DIR.
1841If this is impossible, return FILE unchanged.
1842DIR must be a directory name, not a file name."
492d2437 1843 (or dir (setq dir default-directory))
7425bbff
RS
1844 ;; This case comes into play if default-directory is set to
1845 ;; use ~.
1846 (if (and (> (length dir) 0) (= (aref dir 0) ?~))
1847 (setq dir (expand-file-name dir)))
492d2437
RS
1848 (if (string-match (concat "^" (regexp-quote dir)) file)
1849 (substring file (match-end 0))
7805cdbd 1850;;; (or no-error
827dc60d
RS
1851;;; (error "%s: not in directory tree growing at %s" file dir))
1852 file))
83fadedf 1853\f
492d2437
RS
1854;;; Functions for finding the file name in a dired buffer line.
1855
23e217f6
RS
1856(defvar dired-permission-flags-regexp
1857 "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
1858 "Regular expression to match the permission flags in `ls -l'.")
1859
492d2437
RS
1860;; Move to first char of filename on this line.
1861;; Returns position (point) or nil if no filename on this line."
1862(defun dired-move-to-filename (&optional raise-error eol)
a12c6dca
SM
1863 "Move to the beginning of the filename on the current line.
1864Return the position of the beginning of the filename, or nil if none found."
492d2437 1865 ;; This is the UNIX version.
2b2059d8 1866 (or eol (setq eol (line-end-position)))
492d2437 1867 (beginning-of-line)
0b7bc76f 1868 ;; First try assuming `ls --dired' was used.
2b2059d8
SM
1869 (let ((change (next-single-property-change (point) 'dired-filename nil eol)))
1870 (cond
1871 ((and change (< change eol))
1872 (goto-char change))
9bc260cf 1873 ((re-search-forward directory-listing-before-filename-regexp eol t)
2b2059d8
SM
1874 (goto-char (match-end 0)))
1875 ((re-search-forward dired-permission-flags-regexp eol t)
1876 ;; Ha! There *is* a file. Our regexp-from-hell just failed to find it.
1f3b4d04 1877 (if raise-error
9bc260cf 1878 (error "Unrecognized line! Check directory-listing-before-filename-regexp"))
1f3b4d04
SM
1879 (beginning-of-line)
1880 nil)
2b2059d8
SM
1881 (raise-error
1882 (error "No file on this line")))))
492d2437
RS
1883
1884(defun dired-move-to-end-of-filename (&optional no-error)
1885 ;; Assumes point is at beginning of filename,
1886 ;; thus the rwx bit re-search-backward below will succeed in *this*
1887 ;; line if at all. So, it should be called only after
1888 ;; (dired-move-to-filename t).
1889 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
1890 ;; This is the UNIX version.
0b7bc76f
RS
1891 (if (get-text-property (point) 'dired-filename)
1892 (goto-char (next-single-property-change (point) 'dired-filename))
1893 (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
1894 ;; case-fold-search is nil now, so we can test for capital F:
1895 (setq used-F (string-match "F" dired-actual-switches)
1896 opoint (point)
1897 eol (save-excursion (end-of-line) (point))
1898 hidden (and selective-display
1899 (save-excursion (search-forward "\r" eol t))))
1900 (if hidden
1901 nil
1902 (save-excursion ;; Find out what kind of file this is:
1903 ;; Restrict perm bits to be non-blank,
1904 ;; otherwise this matches one char to early (looking backward):
1905 ;; "l---------" (some systems make symlinks that way)
1906 ;; "----------" (plain file with zero perms)
1907 (if (re-search-backward
1908 dired-permission-flags-regexp nil t)
1909 (setq file-type (char-after (match-beginning 1))
1910 symlink (eq file-type ?l)
1911 ;; Only with -F we need to know whether it's an executable
1912 executable (and
1913 used-F
1914 (string-match
1915 "[xst]" ;; execute bit set anywhere?
1916 (concat
ff3d76aa
SM
1917 (match-string 2)
1918 (match-string 3)
1919 (match-string 4)))))
0b7bc76f
RS
1920 (or no-error (error "No file on this line"))))
1921 ;; Move point to end of name:
1922 (if symlink
a12c6dca 1923 (if (search-forward " -> " eol t)
0b7bc76f 1924 (progn
a12c6dca 1925 (forward-char -4)
0b7bc76f
RS
1926 (and used-F
1927 dired-ls-F-marks-symlinks
1928 (eq (preceding-char) ?@) ;; did ls really mark the link?
1929 (forward-char -1))))
1930 (goto-char eol) ;; else not a symbolic link
dd52fff6
TTN
1931 ;; ls -lF marks dirs, sockets, fifos and executables with exactly
1932 ;; one trailing character. (Executable bits on symlinks ain't mean
0b7bc76f
RS
1933 ;; a thing, even to ls, but we know it's not a symlink.)
1934 (and used-F
dd52fff6 1935 (or (memq file-type '(?d ?s ?p))
0b7bc76f
RS
1936 executable)
1937 (forward-char -1))))
1938 (or no-error
1939 (not (eq opoint (point)))
1940 (error (if hidden
1941 (substitute-command-keys
1942 "File line is hidden, type \\[dired-hide-subdir] to unhide")
1943 "No file on this line")))
1944 (if (eq opoint (point))
1945 nil
1946 (point)))))
492d2437 1947
83fadedf 1948\f
a3f4a3ef
RS
1949;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
1950
1951(defun dired-copy-filename-as-kill (&optional arg)
1952 "Copy names of marked (or next ARG) files into the kill ring.
1953The names are separated by a space.
470fa6d1 1954With a zero prefix arg, use the absolute file name of each marked file.
ee680b2b 1955With \\[universal-argument], use the file name relative to the dired buffer's
afda9919 1956`default-directory'. (This still may contain slashes if in a subdirectory.)
a3f4a3ef 1957
afda9919
LT
1958If on a subdir headerline, use absolute subdirname instead;
1959prefix arg and marked files are ignored in this case.
a3f4a3ef
RS
1960
1961You can then feed the file name(s) to other commands with \\[yank]."
1962 (interactive "P")
1963 (let ((string
1964 (or (dired-get-subdir)
1965 (mapconcat (function identity)
1966 (if arg
1967 (cond ((zerop (prefix-numeric-value arg))
1968 (dired-get-marked-files))
afda9919
LT
1969 ((consp arg)
1970 (dired-get-marked-files t))
1971 (t
1972 (dired-get-marked-files
1973 'no-dir (prefix-numeric-value arg))))
a3f4a3ef
RS
1974 (dired-get-marked-files 'no-dir))
1975 " "))))
4de547e4
RS
1976 (if (eq last-command 'kill-region)
1977 (kill-append string nil)
1978 (kill-new string))
a3f4a3ef
RS
1979 (message "%s" string)))
1980
1981\f
492d2437
RS
1982;; Keeping Dired buffers in sync with the filesystem and with each other
1983
ef746164 1984(defun dired-buffers-for-dir (dir &optional file)
492d2437 1985;; Return a list of buffers that dired DIR (top level or in-situ subdir).
ef746164
RS
1986;; If FILE is non-nil, include only those whose wildcard pattern (if any)
1987;; matches FILE.
492d2437
RS
1988;; The list is in reverse order of buffer creation, most recent last.
1989;; As a side effect, killed dired buffers for DIR are removed from
1990;; dired-buffers.
1991 (setq dir (file-name-as-directory dir))
a12c6dca 1992 (let ((alist dired-buffers) result elt buf)
492d2437 1993 (while alist
38819778
RS
1994 (setq elt (car alist)
1995 buf (cdr elt))
1996 (if (buffer-name buf)
1997 (if (dired-in-this-tree dir (car elt))
ef746164
RS
1998 (with-current-buffer buf
1999 (and (assoc dir dired-subdir-alist)
2000 (or (null file)
2001 (let ((wildcards
2002 (file-name-nondirectory dired-directory)))
2003 (or (= 0 (length wildcards))
2004 (string-match (dired-glob-regexp wildcards)
2005 file))))
2006 (setq result (cons buf result)))))
38819778
RS
2007 ;; else buffer is killed - clean up:
2008 (setq dired-buffers (delq elt dired-buffers)))
492d2437
RS
2009 (setq alist (cdr alist)))
2010 result))
2011
ef746164
RS
2012(defun dired-glob-regexp (pattern)
2013 "Convert glob-pattern PATTERN to a regular expression."
2014 (let ((matched-in-pattern 0) ;; How many chars of PATTERN we've handled.
2015 regexp)
2016 (while (string-match "[[?*]" pattern matched-in-pattern)
2017 (let ((op-end (match-end 0))
2018 (next-op (aref pattern (match-beginning 0))))
2019 (setq regexp (concat regexp
2020 (regexp-quote
2021 (substring pattern matched-in-pattern
2022 (match-beginning 0)))))
2023 (cond ((= next-op ??)
2024 (setq regexp (concat regexp "."))
2025 (setq matched-in-pattern op-end))
2026 ((= next-op ?\[)
2027 ;; Fails to handle ^ yet ????
2028 (let* ((set-start (match-beginning 0))
2029 (set-cont
2030 (if (= (aref pattern (1+ set-start)) ?^)
2031 (+ 3 set-start)
2032 (+ 2 set-start)))
2033 (set-end (string-match "]" pattern set-cont))
2034 (set (substring pattern set-start (1+ set-end))))
2035 (setq regexp (concat regexp set))
2036 (setq matched-in-pattern (1+ set-end))))
2037 ((= next-op ?*)
2038 (setq regexp (concat regexp ".*"))
2039 (setq matched-in-pattern op-end)))))
2040 (concat "\\`"
2041 regexp
2042 (regexp-quote
2043 (substring pattern matched-in-pattern))
2044 "\\'")))
2045
c60ee5e7 2046
ef746164 2047
492d2437
RS
2048(defun dired-advertise ()
2049 ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
2050 ;; With wildcards we actually advertise too much.
38819778
RS
2051 (let ((expanded-default (expand-file-name default-directory)))
2052 (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
2053 t ; we have already advertised ourselves
2054 (setq dired-buffers
2055 (cons (cons expanded-default (current-buffer))
2056 dired-buffers)))))
492d2437
RS
2057
2058(defun dired-unadvertise (dir)
2059 ;; Remove DIR from the buffer alist in variable dired-buffers.
2060 ;; This has the effect of removing any buffer whose main directory is DIR.
2061 ;; It does not affect buffers in which DIR is a subdir.
2062 ;; Removing is also done as a side-effect in dired-buffer-for-dir.
2063 (setq dired-buffers
38819778 2064 (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
83fadedf 2065\f
492d2437
RS
2066;; Tree Dired
2067
2068;;; utility functions
2069
2070(defun dired-in-this-tree (file dir)
2071 ;;"Is FILE part of the directory tree starting at DIR?"
2072 (let (case-fold-search)
38819778 2073 (string-match (concat "^" (regexp-quote dir)) file)))
492d2437
RS
2074
2075(defun dired-normalize-subdir (dir)
470fa6d1
KS
2076 ;; Prepend default-directory to DIR if relative file name.
2077 ;; dired-get-filename must be able to make a valid file name from a
492d2437
RS
2078 ;; file and its directory DIR.
2079 (file-name-as-directory
2080 (if (file-name-absolute-p dir)
2081 dir
2082 (expand-file-name dir default-directory))))
2083
2084(defun dired-get-subdir ()
2085 ;;"Return the subdir name on this line, or nil if not on a headerline."
2086 ;; Look up in the alist whether this is a headerline.
2087 (save-excursion
2088 (let ((cur-dir (dired-current-directory)))
2089 (beginning-of-line) ; alist stores b-o-l positions
2090 (and (zerop (- (point)
2091 (dired-get-subdir-min (assoc cur-dir
2092 dired-subdir-alist))))
2093 cur-dir))))
2094
2095;(defun dired-get-subdir-min (elt)
2096; (cdr elt))
2097;; can't use macro, must be redefinable for other alist format in dired-nstd.
62f61df0 2098(defalias 'dired-get-subdir-min 'cdr)
492d2437
RS
2099
2100(defun dired-get-subdir-max (elt)
84fc2cfa 2101 (save-excursion
492d2437
RS
2102 (goto-char (dired-get-subdir-min elt))
2103 (dired-subdir-max)))
2104
2105(defun dired-clear-alist ()
2106 (while dired-subdir-alist
2107 (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
2108 (setq dired-subdir-alist (cdr dired-subdir-alist))))
2109
c9d59fc2
RS
2110(defun dired-subdir-index (dir)
2111 ;; Return an index into alist for use with nth
2112 ;; for the sake of subdir moving commands.
2113 (let (found (index 0) (alist dired-subdir-alist))
2114 (while alist
2115 (if (string= dir (car (car alist)))
2116 (setq alist nil found t)
2117 (setq alist (cdr alist) index (1+ index))))
2118 (if found index nil)))
2119
2120(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
2121 "Go to next subdirectory, regardless of level."
2122 ;; Use 0 arg to go to this directory's header line.
2123 ;; NO-SKIP prevents moving to end of header line, returning whatever
2124 ;; position was found in dired-subdir-alist.
2125 (interactive "p")
2126 (let ((this-dir (dired-current-directory))
2127 pos index)
2128 ;; nth with negative arg does not return nil but the first element
2129 (setq index (- (dired-subdir-index this-dir) arg))
2130 (setq pos (if (>= index 0)
2131 (dired-get-subdir-min (nth index dired-subdir-alist))))
2132 (if pos
2133 (progn
2134 (goto-char pos)
2135 (or no-skip (skip-chars-forward "^\n\r"))
2136 (point))
2137 (if no-error-if-not-found
2138 nil ; return nil if not found
2139 (error "%s directory" (if (> arg 0) "Last" "First"))))))
2140
3c13627a 2141(defun dired-build-subdir-alist (&optional switches)
492d2437 2142 "Build `dired-subdir-alist' by parsing the buffer.
3c13627a
EZ
2143Returns the new value of the alist.
2144If optional arg SWITCHES is non-nil, use its value
2145instead of `dired-actual-switches'."
492d2437
RS
2146 (interactive)
2147 (dired-clear-alist)
2148 (save-excursion
3c13627a
EZ
2149 (let* ((count 0)
2150 (buffer-read-only nil)
784a48b2 2151 (buffer-undo-list t)
3c13627a
EZ
2152 (switches (or switches dired-actual-switches))
2153 new-dir-name
2154 (R-ftp-base-dir-regex
2155 ;; Used to expand subdirectory names correctly in recursive
2156 ;; ange-ftp listings.
2157 (and (string-match "R" switches)
2158 (string-match "\\`/.*:\\(/.*\\)" default-directory)
2159 (concat "\\`" (match-string 1 default-directory)))))
84fc2cfa 2160 (goto-char (point-min))
492d2437 2161 (setq dired-subdir-alist nil)
acf310c9
RS
2162 (while (and (re-search-forward dired-subdir-regexp nil t)
2163 ;; Avoid taking a file name ending in a colon
2164 ;; as a subdir name.
2165 (not (save-excursion
2166 (goto-char (match-beginning 0))
2167 (beginning-of-line)
2168 (forward-char 2)
46680faf 2169 (save-match-data (looking-at dired-re-perms)))))
3222085e
BF
2170 (save-excursion
2171 (goto-char (match-beginning 1))
2172 (setq new-dir-name
b4c01776
GM
2173 (buffer-substring-no-properties (point) (match-end 1))
2174 new-dir-name
2175 (save-match-data
2176 (if (and R-ftp-base-dir-regex
2177 (not (string= new-dir-name default-directory))
2178 (string-match R-ftp-base-dir-regex new-dir-name))
2179 (concat default-directory
2180 (substring new-dir-name (match-end 0)))
2181 (expand-file-name new-dir-name))))
3222085e
BF
2182 (delete-region (point) (match-end 1))
2183 (insert new-dir-name))
492d2437 2184 (setq count (1+ count))
3222085e
BF
2185 (dired-alist-add-1 new-dir-name
2186 ;; Place a sub directory boundary between lines.
2187 (save-excursion
2188 (goto-char (match-beginning 0))
2189 (beginning-of-line)
2190 (point-marker))))
5553077c 2191 (if (and (> count 1) (interactive-p))
c9d59fc2 2192 (message "Buffer includes %d directories" count))
492d2437
RS
2193 ;; We don't need to sort it because it is in buffer order per
2194 ;; constructionem. Return new alist:
2195 dired-subdir-alist)))
2196
2197(defun dired-alist-add-1 (dir new-marker)
2198 ;; Add new DIR at NEW-MARKER. Don't sort.
2199 (setq dired-subdir-alist
2200 (cons (cons (dired-normalize-subdir dir) new-marker)
2201 dired-subdir-alist)))
2202
2203(defun dired-goto-next-nontrivial-file ()
2204 ;; Position point on first nontrivial file after point.
2205 (dired-goto-next-file);; so there is a file to compare with
2206 (if (stringp dired-trivial-filenames)
2207 (while (and (not (eobp))
2208 (string-match dired-trivial-filenames
2209 (file-name-nondirectory
2210 (or (dired-get-filename nil t) ""))))
2211 (forward-line 1)
2212 (dired-move-to-filename))))
2213
2214(defun dired-goto-next-file ()
2215 (let ((max (1- (dired-subdir-max))))
2216 (while (and (not (dired-move-to-filename)) (< (point) max))
2217 (forward-line 1))))
2218
2219(defun dired-goto-file (file)
2220 "Go to file line of FILE in this dired buffer."
2221 ;; Return value of point on success, else nil.
470fa6d1 2222 ;; FILE must be an absolute file name.
492d2437
RS
2223 ;; Loses if FILE contains control chars like "\007" for which ls
2224 ;; either inserts "?" or "\\007" into the buffer, so we won't find
2225 ;; it in the buffer.
2226 (interactive
2227 (prog1 ; let push-mark display its message
2228 (list (expand-file-name
2229 (read-file-name "Goto file: "
2230 (dired-current-directory))))
2231 (push-mark)))
2232 (setq file (directory-file-name file)) ; does no harm if no directory
2233 (let (found case-fold-search dir)
2234 (setq dir (or (file-name-directory file)
f808da9e 2235 (error "File name `%s' is not absolute" file)))
492d2437
RS
2236 (save-excursion
2237 ;; The hair here is to get the result of dired-goto-subdir
2238 ;; without really calling it if we don't have any subdirs.
233993a3 2239 (if (if (string= dir (expand-file-name default-directory))
492d2437 2240 (goto-char (point-min))
7b2469ae 2241 (and (cdr dired-subdir-alist)
492d2437
RS
2242 (dired-goto-subdir dir)))
2243 (let ((base (file-name-nondirectory file))
f808da9e 2244 search-string
492d2437 2245 (boundary (dired-subdir-max)))
f808da9e
RS
2246 (setq search-string
2247 (replace-regexp-in-string "\^m" "\\^m" base nil t))
2248 (setq search-string
2249 (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
492d2437
RS
2250 (while (and (not found)
2251 ;; filenames are preceded by SPC, this makes
2252 ;; the search faster (e.g. for the filename "-"!).
f808da9e
RS
2253 (search-forward (concat " " search-string)
2254 boundary 'move))
492d2437
RS
2255 ;; Match could have BASE just as initial substring or
2256 ;; or in permission bits or date or
2257 ;; not be a proper filename at all:
2258 (if (equal base (dired-get-filename 'no-dir t))
2259 ;; Must move to filename since an (actually
2260 ;; correct) match could have been elsewhere on the
2261 ;; ;; line (e.g. "-" would match somewhere in the
2262 ;; permission bits).
55e86af6
RS
2263 (setq found (dired-move-to-filename))
2264 ;; If this isn't the right line, move forward to avoid
2265 ;; trying this line again.
2266 (forward-line 1))))))
492d2437
RS
2267 (and found
2268 ;; return value of point (i.e., FOUND):
2269 (goto-char found))))
2270
2271(defun dired-initial-position (dirname)
2272 ;; Where point should go in a new listing of DIRNAME.
2273 ;; Point assumed at beginning of new subdir line.
2274 ;; You may redefine this function as you wish, e.g. like in dired-x.el.
2275 (end-of-line)
2276 (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
83fadedf 2277\f
492d2437
RS
2278;; These are hooks which make tree dired work.
2279;; They are in this file because other parts of dired need to call them.
2280;; But they don't call the rest of tree dired unless there are subdirs loaded.
2281
2282;; This function is called for each retrieved filename.
2283;; It could stand to be faster, though it's mostly function call
2284;; overhead. Avoiding the function call seems to save about 10% in
2285;; dired-get-filename. Make it a defsubst?
2286(defun dired-current-directory (&optional localp)
2287 "Return the name of the subdirectory to which this line belongs.
2288This returns a string with trailing slash, like `default-directory'.
2289Optional argument means return a file name relative to `default-directory'."
2290 (let ((here (point))
2291 (alist (or dired-subdir-alist
2292 ;; probably because called in a non-dired buffer
2293 (error "No subdir-alist in %s" (current-buffer))))
2294 elt dir)
2295 (while alist
2296 (setq elt (car alist)
2297 dir (car elt)
2298 ;; use `<=' (not `<') as subdir line is part of subdir
2299 alist (if (<= (dired-get-subdir-min elt) here)
2300 nil ; found
2301 (cdr alist))))
2302 (if localp
2303 (dired-make-relative dir default-directory)
2304 dir)))
2305
2306;; Subdirs start at the beginning of their header lines and end just
2307;; before the beginning of the next header line (or end of buffer).
2308
2309(defun dired-subdir-max ()
2310 (save-excursion
7b2469ae 2311 (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
492d2437
RS
2312 (point-max)
2313 (point))))
83fadedf 2314\f
492d2437
RS
2315;; Deleting files
2316
f0628026
RS
2317(defcustom dired-recursive-deletes nil ; Default only delete empty directories.
2318 "*Decide whether recursive deletes are allowed.
f0529b5b 2319nil means no recursive deletes.
f0628026
RS
2320`always' means delete recursively without asking. This is DANGEROUS!
2321`top' means ask for each directory at top level, but delete its subdirectories
2322without asking.
2323Anything else means ask for each directory."
53ade5c7
RS
2324 :type '(choice :tag "Delete non-empty directories"
2325 (const :tag "Yes" always)
2326 (const :tag "No--only delete empty directories" nil)
2327 (const :tag "Confirm for each directory" t)
2328 (const :tag "Confirm for each top directory only" top))
f0628026
RS
2329 :group 'dired)
2330
c60ee5e7 2331;; Match anything but `.' and `..'.
f0628026
RS
2332(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
2333
2334;; Delete file, possibly delete a directory and all its files.
2335;; This function is usefull outside of dired. One could change it's name
2336;; to e.g. recursive-delete-file and put it somewhere else.
2337(defun dired-delete-file (file &optional recursive) "\
2338Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
2339RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
ee680b2b 2340nil, do not delete.
f0628026
RS
2341`always', delete recursively without asking.
2342`top', ask for each directory at top level.
2343Anything else, ask for each sub-directory."
2344 (let (files)
2345 ;; This test is equivalent to
2346 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
2347 ;; but more efficient
2348 (if (not (eq t (car (file-attributes file))))
2349 (delete-file file)
2350 (when (and recursive
2351 (setq files
2352 (directory-files file t dired-re-no-dot)) ; Not empty.
2353 (or (eq recursive 'always)
ce5a3ac0 2354 (yes-or-no-p (format "Recursive delete of %s? "
f0628026
RS
2355 (dired-make-relative file)))))
2356 (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
2357 (while files ; Recursively delete (possibly asking).
2358 (dired-delete-file (car files) recursive)
2359 (setq files (cdr files))))
2360 (delete-directory file))))
2361
7da0e9b4 2362(defun dired-do-flagged-delete (&optional nomessage)
68d2f12f 2363 "In Dired, delete the files flagged for deletion.
7da0e9b4
RS
2364If NOMESSAGE is non-nil, we don't display any message
2365if there are no flagged files."
492d2437
RS
2366 (interactive)
2367 (let* ((dired-marker-char dired-del-marker)
2368 (regexp (dired-marker-regexp))
2369 case-fold-search)
2370 (if (save-excursion (goto-char (point-min))
2371 (re-search-forward regexp nil t))
2372 (dired-internal-do-deletions
2373 ;; this can't move point since ARG is nil
2374 (dired-map-over-marks (cons (dired-get-filename) (point))
2375 nil)
2376 nil)
7da0e9b4
RS
2377 (or nomessage
2378 (message "(No deletions requested)")))))
492d2437
RS
2379
2380(defun dired-do-delete (&optional arg)
2381 "Delete all marked (or next ARG) files."
2382 ;; This is more consistent with the file marking feature than
2383 ;; dired-do-flagged-delete.
2384 (interactive "P")
2385 (dired-internal-do-deletions
2386 ;; this may move point if ARG is an integer
2387 (dired-map-over-marks (cons (dired-get-filename) (point))
2388 arg)
2389 arg))
2390
2391(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
2392
2393(defun dired-internal-do-deletions (l arg)
2394 ;; L is an alist of files to delete, with their buffer positions.
2395 ;; ARG is the prefix arg.
2396 ;; Filenames are absolute (VMS needs this for logical search paths).
2397 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
2398 ;; That way as changes are made in the buffer they do not shift the
2399 ;; lines still to be changed, so the (point) values in L stay valid.
2400 ;; Also, for subdirs in natural order, a subdir's files are deleted
2401 ;; before the subdir itself - the other way around would not work.
2402 (let ((files (mapcar (function car) l))
2403 (count (length l))
2404 (succ 0))
2405 ;; canonicalize file list for pop up
2406 (setq files (nreverse (mapcar (function dired-make-relative) files)))
2407 (if (dired-mark-pop-up
2408 " *Deletions*" 'delete files dired-deletion-confirmer
2409 (format "Delete %s " (dired-mark-prompt arg files)))
84fc2cfa 2410 (save-excursion
492d2437
RS
2411 (let (failures);; files better be in reverse order for this loop!
2412 (while l
2413 (goto-char (cdr (car l)))
2414 (let (buffer-read-only)
2415 (condition-case err
2416 (let ((fn (car (car l))))
f0628026 2417 (dired-delete-file fn dired-recursive-deletes)
492d2437
RS
2418 ;; if we get here, removing worked
2419 (setq succ (1+ succ))
2420 (message "%s of %s deletions" succ count)
bf989169
RS
2421 (dired-fun-in-all-buffers
2422 (file-name-directory fn) (file-name-nondirectory fn)
2423 (function dired-delete-entry) fn))
492d2437
RS
2424 (error;; catch errors from failed deletions
2425 (dired-log "%s\n" err)
2426 (setq failures (cons (car (car l)) failures)))))
2427 (setq l (cdr l)))
2428 (if (not failures)
2429 (message "%d deletion%s done" count (dired-plural-s count))
2430 (dired-log-summary
2431 (format "%d of %d deletion%s failed"
2432 (length failures) count
2433 (dired-plural-s count))
2434 failures))))
2435 (message "(No deletions performed)")))
2436 (dired-move-to-filename))
2437
bf989169
RS
2438(defun dired-fun-in-all-buffers (directory file fun &rest args)
2439 ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
2440 ;; If the buffer has a wildcard pattern, check that it matches FILE.
2441 ;; (FILE does not include a directory component.)
2442 ;; FILE may be nil, in which case ignore it.
2443 ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
2444 (let (success-list)
2445 (dolist (buf (dired-buffers-for-dir (expand-file-name directory)
2446 file))
2447 (with-current-buffer buf
2448 (if (apply fun args)
2449 (setq success-list (cons (buffer-name buf) success-list)))))
2450 success-list))
2451
c60ee5e7 2452;; Delete the entry for FILE from
bf989169
RS
2453(defun dired-delete-entry (file)
2454 (save-excursion
2455 (and (dired-goto-file file)
2456 (let (buffer-read-only)
2457 (delete-region (progn (beginning-of-line) (point))
2458 (save-excursion (forward-line 1) (point))))))
2459 (dired-clean-up-after-deletion file))
2460
492d2437
RS
2461;; This is a separate function for the sake of dired-x.el.
2462(defun dired-clean-up-after-deletion (fn)
2463 ;; Clean up after a deleted file or directory FN.
7b2469ae
RS
2464 (save-excursion (and (cdr dired-subdir-alist)
2465 (dired-goto-subdir fn)
492d2437 2466 (dired-kill-subdir))))
83fadedf 2467\f
492d2437
RS
2468;; Confirmation
2469
2470(defun dired-marker-regexp ()
2471 (concat "^" (regexp-quote (char-to-string dired-marker-char))))
2472
2473(defun dired-plural-s (count)
2474 (if (= 1 count) "" "s"))
2475
2476(defun dired-mark-prompt (arg files)
2477 ;; Return a string for use in a prompt, either the current file
2478 ;; name, or the marker and a count of marked files.
2479 (let ((count (length files)))
2480 (if (= count 1)
2481 (car files)
2482 ;; more than 1 file:
2483 (if (integerp arg)
2484 ;; abs(arg) = count
2485 ;; Perhaps this is nicer, but it also takes more screen space:
2486 ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
2487 ;; count)
2488 (format "[next %d files]" arg)
2489 (format "%c [%d files]" dired-marker-char count)))))
2490
2491(defun dired-pop-to-buffer (buf)
2492 ;; Pop up buffer BUF.
2493 ;; If dired-shrink-to-fit is t, make its window fit its contents.
2494 (if (not dired-shrink-to-fit)
2495 (pop-to-buffer (get-buffer-create buf))
2496 ;; let window shrink to fit:
2497 (let ((window (selected-window))
2498 target-lines w2)
54f03575 2499 (cond ;; if split-height-threshold is enabled, use the largest window
492d2437
RS
2500 ((and (> (window-height (setq w2 (get-largest-window)))
2501 split-height-threshold)
f98955ea 2502 (= (frame-width) (window-width w2)))
492d2437
RS
2503 (setq window w2))
2504 ;; if the least-recently-used window is big enough, use it
2505 ((and (> (window-height (setq w2 (get-lru-window)))
2506 (* 2 window-min-height))
f98955ea 2507 (= (frame-width) (window-width w2)))
492d2437
RS
2508 (setq window w2)))
2509 (save-excursion
2510 (set-buffer buf)
2511 (goto-char (point-max))
2512 (skip-chars-backward "\n\r\t ")
63ea14a5
RS
2513 (setq target-lines (count-lines (point-min) (point)))
2514 ;; Don't forget to count the last line.
2515 (if (not (bolp))
2516 (setq target-lines (1+ target-lines))))
492d2437 2517 (if (<= (window-height window) (* 2 window-min-height))
f98955ea 2518 ;; At this point, every window on the frame is too small to split.
492d2437
RS
2519 (setq w2 (display-buffer buf))
2520 (setq w2 (split-window window
2521 (max window-min-height
2522 (- (window-height window)
2523 (1+ (max window-min-height target-lines)))))))
2524 (set-window-buffer w2 buf)
2525 (if (< (1- (window-height w2)) target-lines)
2526 (progn
2527 (select-window w2)
2528 (enlarge-window (- target-lines (1- (window-height w2))))))
2529 (set-window-start w2 1)
2530 )))
2531
5afea280 2532(defcustom dired-no-confirm nil
ee680b2b 2533 "A list of symbols for commands Dired should not confirm.
0347d069 2534Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
57654b8c 2535`copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink',
5afea280
RS
2536`touch' and `uncompress'."
2537 :group 'dired
75461997
LT
2538 :type '(set (const byte-compile) (const chgrp)
2539 (const chmod) (const chown) (const compress)
2540 (const copy) (const delete) (const hardlink)
2541 (const load) (const move) (const print)
2542 (const shell) (const symlink) (const touch)
2543 (const uncompress)))
492d2437
RS
2544
2545(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
8421685f
RS
2546 "Return FUNCTION's result on ARGS after showing which files are marked.
2547Displays the file names in a buffer named BUFNAME;
2548 nil gives \" *Marked Files*\".
2549This uses function `dired-pop-to-buffer' to do that.
2550
2551FUNCTION should not manipulate files, just read input
2552 (an argument or confirmation).
89101e46
SM
2553The window is not shown if there is just one file or
2554 OP-SYMBOL is a member of the list in `dired-no-confirm'.
09b092ad
RS
2555FILES is the list of marked files. It can also be (t FILENAME)
2556in the case of one marked file, to distinguish that from using
2557just the current file."
492d2437 2558 (or bufname (setq bufname " *Marked Files*"))
0347d069
SM
2559 (if (or (eq dired-no-confirm t)
2560 (memq op-symbol dired-no-confirm)
09b092ad 2561 ;; If FILES defaulted to the current line's file.
492d2437
RS
2562 (= (length files) 1))
2563 (apply function args)
89101e46 2564 (with-current-buffer (get-buffer-create bufname)
492d2437 2565 (erase-buffer)
09b092ad
RS
2566 ;; Handle (t FILE) just like (FILE), here.
2567 ;; That value is used (only in some cases), to mean
2568 ;; just one file that was marked, rather than the current line file.
2569 (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files))
1a0b9ae6
EZ
2570 (remove-text-properties (point-min) (point-max)
2571 '(mouse-face nil help-echo nil)))
492d2437
RS
2572 (save-window-excursion
2573 (dired-pop-to-buffer bufname)
2574 (apply function args))))
2575
2576(defun dired-format-columns-of-files (files)
2577 ;; Files should be in forward order for this loop.
2578 ;; i.e., (car files) = first file in buffer.
2579 ;; Returns the number of lines used.
2580 (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
2581 (width (- (window-width (selected-window)) 2))
2582 (columns (max 1 (/ width maxlen)))
2583 (nfiles (length files))
2584 (rows (+ (/ nfiles columns)
2585 (if (zerop (% nfiles columns)) 0 1)))
2586 (i 0)
2587 (j 0))
2588 (setq files (nconc (copy-sequence files) ; fill up with empty fns
2589 (make-list (- (* columns rows) nfiles) "")))
2590 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
2591 (while (< j rows)
2592 (while (< i columns)
2593 (indent-to (* i maxlen))
2594 (insert (car files))
2595 (setq files (nthcdr rows files)
2596 i (1+ i)))
2597 (insert "\n")
2598 (setq i 0
2599 j (1+ j)
2600 files (cdr files)))
2601 rows))
83fadedf 2602\f
492d2437
RS
2603;; Commands to mark or flag file(s) at or near current line.
2604
2605(defun dired-repeat-over-lines (arg function)
2606 ;; This version skips non-file lines.
cfe89c4f 2607 (let ((pos (make-marker)))
492d2437 2608 (beginning-of-line)
cfe89c4f
RS
2609 (while (and (> arg 0) (not (eobp)))
2610 (setq arg (1- arg))
2611 (beginning-of-line)
2612 (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
2613 (save-excursion
2614 (forward-line 1)
2615 (move-marker pos (1+ (point))))
2616 (save-excursion (funcall function))
2617 ;; Advance to the next line--actually, to the line that *was* next.
2618 ;; (If FUNCTION inserted some new lines in between, skip them.)
2619 (goto-char pos))
2620 (while (and (< arg 0) (not (bobp)))
2621 (setq arg (1+ arg))
2622 (forward-line -1)
2623 (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
2624 (beginning-of-line)
2625 (save-excursion (funcall function)))
2626 (move-marker pos nil)
2627 (dired-move-to-filename)))
492d2437
RS
2628
2629(defun dired-between-files ()
8a372755
MB
2630 ;; This used to be a regexp match of the `total ...' line output by
2631 ;; ls, which is slightly faster, but that is not very robust; notably,
2632 ;; it fails for non-english locales.
2633 (save-excursion (not (dired-move-to-filename))))
492d2437
RS
2634
2635(defun dired-next-marked-file (arg &optional wrap opoint)
2636 "Move to the next marked file, wrapping around the end of the buffer."
2637 (interactive "p\np")
2638 (or opoint (setq opoint (point)));; return to where interactively started
2639 (if (if (> arg 0)
2640 (re-search-forward dired-re-mark nil t arg)
2641 (beginning-of-line)
2642 (re-search-backward dired-re-mark nil t (- arg)))
2643 (dired-move-to-filename)
2644 (if (null wrap)
2645 (progn
2646 (goto-char opoint)
2647 (error "No next marked file"))
2648 (message "(Wraparound for next marked file)")
2649 (goto-char (if (> arg 0) (point-min) (point-max)))
2650 (dired-next-marked-file arg nil opoint))))
2651
2652(defun dired-prev-marked-file (arg &optional wrap)
2653 "Move to the previous marked file, wrapping around the end of the buffer."
2654 (interactive "p\np")
2655 (dired-next-marked-file (- arg) wrap))
2656
2657(defun dired-file-marker (file)
2658 ;; Return FILE's marker, or nil if unmarked.
2659 (save-excursion
2660 (and (dired-goto-file file)
2661 (progn
2662 (beginning-of-line)
2663 (if (not (equal ?\040 (following-char)))
2664 (following-char))))))
2665
2666(defun dired-mark-files-in-region (start end)
2667 (let (buffer-read-only)
2668 (if (> start end)
2669 (error "start > end"))
2670 (goto-char start) ; assumed at beginning of line
2671 (while (< (point) end)
2672 ;; Skip subdir line and following garbage like the `total' line:
2673 (while (and (< (point) end) (dired-between-files))
2674 (forward-line 1))
2675 (if (and (not (looking-at dired-re-dot))
2676 (dired-get-filename nil t))
2677 (progn
2678 (delete-char 1)
2679 (insert dired-marker-char)))
2680 (forward-line 1))))
2681
2682(defun dired-mark (arg)
2683 "Mark the current (or next ARG) files.
2684If on a subdir headerline, mark all its files except `.' and `..'.
2685
2686Use \\[dired-unmark-all-files] to remove all marks
2687and \\[dired-unmark] on a subdir to remove the marks in
2688this subdir."
2689 (interactive "P")
277568f2 2690 (if (dired-get-subdir)
492d2437
RS
2691 (save-excursion (dired-mark-subdir-files))
2692 (let (buffer-read-only)
2693 (dired-repeat-over-lines
52041219 2694 (prefix-numeric-value arg)
492d2437
RS
2695 (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
2696
2697(defun dired-unmark (arg)
2698 "Unmark the current (or next ARG) files.
2699If looking at a subdir, unmark all its files except `.' and `..'."
2700 (interactive "P")
2701 (let ((dired-marker-char ?\040))
2702 (dired-mark arg)))
2703
2704(defun dired-flag-file-deletion (arg)
68d2f12f 2705 "In Dired, flag the current line's file for deletion.
492d2437
RS
2706With prefix arg, repeat over several lines.
2707
2708If on a subdir headerline, mark all its files except `.' and `..'."
2709 (interactive "P")
2710 (let ((dired-marker-char dired-del-marker))
2711 (dired-mark arg)))
2712
2713(defun dired-unmark-backward (arg)
68d2f12f 2714 "In Dired, move up lines and remove deletion flag there.
492d2437
RS
2715Optional prefix ARG says how many lines to unflag; default is one line."
2716 (interactive "p")
2717 (dired-unmark (- arg)))
e5f0841e 2718
d588eb90
RS
2719(defun dired-toggle-marks ()
2720 "Toggle marks: marked files become unmarked, and vice versa.
e5f0841e
KH
2721Files marked with other flags (such as `D') are not affected.
2722`.' and `..' are never toggled.
2723As always, hidden subdirs are not affected."
2724 (interactive)
2725 (save-excursion
2726 (goto-char (point-min))
2727 (let (buffer-read-only)
2728 (while (not (eobp))
2729 (or (dired-between-files)
2730 (looking-at dired-re-dot)
2731 ;; use subst instead of insdel because it does not move
2732 ;; the gap and thus should be faster and because
2733 ;; other characters are left alone automatically
2734 (apply 'subst-char-in-region
2735 (point) (1+ (point))
2736 (if (eq ?\040 (following-char)) ; SPC
2737 (list ?\040 dired-marker-char)
2738 (list dired-marker-char ?\040))))
2739 (forward-line 1)))))
83fadedf 2740\f
492d2437
RS
2741;;; Commands to mark or flag files based on their characteristics or names.
2742
d2cadc4b
RS
2743(defvar dired-regexp-history nil
2744 "History list of regular expressions used in Dired commands.")
2745
2746(defun dired-read-regexp (prompt)
2747 (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
492d2437
RS
2748
2749(defun dired-mark-files-regexp (regexp &optional marker-char)
2750 "Mark all files matching REGEXP for use in later commands.
2751A prefix argument means to unmark them instead.
2752`.' and `..' are never marked.
2753
2754REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
2755object files--just `.o' will mark more than you might think."
2756 (interactive
2757 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
2758 " files (regexp): "))
2759 (if current-prefix-arg ?\040)))
2760 (let ((dired-marker-char (or marker-char dired-marker-char)))
2761 (dired-mark-if
2762 (and (not (looking-at dired-re-dot))
2763 (not (eolp)) ; empty line
2764 (let ((fn (dired-get-filename nil t)))
2765 (and fn (string-match regexp (file-name-nondirectory fn)))))
2766 "matching file")))
2767
e9b8e22d
RS
2768(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
2769 "Mark all files with contents containing REGEXP for use in later commands.
2770A prefix argument means to unmark them instead.
2771`.' and `..' are never marked."
2772 (interactive
2773 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
2774 " files containing (regexp): "))
2775 (if current-prefix-arg ?\040)))
2776 (let ((dired-marker-char (or marker-char dired-marker-char)))
2777 (dired-mark-if
2778 (and (not (looking-at dired-re-dot))
2779 (not (eolp)) ; empty line
2780 (let ((fn (dired-get-filename nil t)))
05a40373
KH
2781 (when (and fn (file-readable-p fn)
2782 (not (file-directory-p fn)))
2783 (let ((prebuf (get-file-buffer fn)))
2784 (message "Checking %s" fn)
2785 ;; For now we do it inside emacs
2786 ;; Grep might be better if there are a lot of files
2787 (if prebuf
2788 (with-current-buffer prebuf
2789 (save-excursion
2790 (goto-char (point-min))
2791 (re-search-forward regexp nil t)))
2792 (with-temp-buffer
2793 (insert-file-contents fn)
2794 (goto-char (point-min))
2795 (re-search-forward regexp nil t))))
0b2bb4d0 2796 )))
e9b8e22d
RS
2797 "matching file")))
2798
492d2437 2799(defun dired-flag-files-regexp (regexp)
68d2f12f 2800 "In Dired, flag all files containing the specified REGEXP for deletion.
492d2437
RS
2801The match is against the non-directory part of the filename. Use `^'
2802 and `$' to anchor matches. Exclude subdirs by hiding them.
2803`.' and `..' are never flagged."
2804 (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
2805 (dired-mark-files-regexp regexp dired-del-marker))
2806
2807(defun dired-mark-symlinks (unflag-p)
2808 "Mark all symbolic links.
2809With prefix argument, unflag all those files."
2810 (interactive "P")
2811 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
2812 (dired-mark-if (looking-at dired-re-sym) "symbolic link")))
2813
2814(defun dired-mark-directories (unflag-p)
2815 "Mark all directory file lines except `.' and `..'.
2816With prefix argument, unflag all those files."
2817 (interactive "P")
2818 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
2819 (dired-mark-if (and (looking-at dired-re-dir)
2820 (not (looking-at dired-re-dot)))
2821 "directory file")))
2822
2823(defun dired-mark-executables (unflag-p)
2824 "Mark all executable files.
2825With prefix argument, unflag all those files."
2826 (interactive "P")
2827 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
2828 (dired-mark-if (looking-at dired-re-exe) "executable file")))
2829
2830;; dired-x.el has a dired-mark-sexp interactive command: mark
2831;; files for which PREDICATE returns non-nil.
2832
2833(defun dired-flag-auto-save-files (&optional unflag-p)
84fc2cfa
ER
2834 "Flag for deletion files whose names suggest they are auto save files.
2835A prefix argument says to unflag those files instead."
2836 (interactive "P")
492d2437
RS
2837 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
2838 (dired-mark-if
2a838614 2839 ;; It is less than general to check for # here,
a91526b9
RS
2840 ;; but it's the only way this runs fast enough.
2841 (and (save-excursion (end-of-line)
536ae2dd
RS
2842 (or
2843 (eq (preceding-char) ?#)
2844 ;; Handle executables in case of -F option.
2845 ;; We need not worry about the other kinds
2846 ;; of markings that -F makes, since they won't
2847 ;; appear on real auto-save files.
2848 (if (eq (preceding-char) ?*)
2849 (progn
2850 (forward-char -1)
2851 (eq (preceding-char) ?#)))))
a91526b9
RS
2852 (not (looking-at dired-re-dir))
2853 (let ((fn (dired-get-filename t t)))
2854 (if fn (auto-save-file-name-p
2855 (file-name-nondirectory fn)))))
2856 "auto save file")))
492d2437 2857
d7aed37c 2858(defcustom dired-garbage-files-regexp
6736ab5a 2859 ;; `log' here is dubious, since it's typically used for useful log
d7aed37c 2860 ;; files, not just TeX stuff. -- fx
d4aeef3b
KG
2861 (concat (regexp-opt
2862 '(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux"))
c60ee5e7 2863 "\\'")
d7aed37c
SM
2864 "Regular expression to match \"garbage\" files for `dired-flag-garbage-files'."
2865 :type 'regexp
2866 :group 'dired)
84d3f6e8
RS
2867
2868(defun dired-flag-garbage-files ()
84d3f6e8 2869 "Flag for deletion all files that match `dired-garbage-files-regexp'."
f656ec48 2870 (interactive)
84d3f6e8
RS
2871 (dired-flag-files-regexp dired-garbage-files-regexp))
2872
492d2437
RS
2873(defun dired-flag-backup-files (&optional unflag-p)
2874 "Flag all backup files (names ending with `~') for deletion.
2875With prefix argument, unflag these files."
2876 (interactive "P")
ee680b2b 2877 (let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
492d2437 2878 (dired-mark-if
f13101e9
KH
2879 ;; Don't call backup-file-name-p unless the last character looks like
2880 ;; it might be the end of a backup file name. This isn't very general,
a91526b9
RS
2881 ;; but it's the only way this runs fast enough.
2882 (and (save-excursion (end-of-line)
f13101e9
KH
2883 ;; Handle executables in case of -F option.
2884 ;; We need not worry about the other kinds
2885 ;; of markings that -F makes, since they won't
2886 ;; appear on real backup files.
2887 (if (eq (preceding-char) ?*)
2888 (forward-char -1))
fdee13ec 2889 (eq (preceding-char) ?~))
a91526b9 2890 (not (looking-at dired-re-dir))
492d2437
RS
2891 (let ((fn (dired-get-filename t t)))
2892 (if fn (backup-file-name-p fn))))
2893 "backup file")))
2894
6482fcac
RS
2895(defun dired-change-marks (&optional old new)
2896 "Change all OLD marks to NEW marks.
2897OLD and NEW are both characters used to mark files."
2898 (interactive
2899 (let* ((cursor-in-echo-area t)
2900 (old (progn (message "Change (old mark): ") (read-char)))
2901 (new (progn (message "Change %c marks to (new mark): " old)
2902 (read-char))))
2903 (list old new)))
e4e02841
RS
2904 (if (or (eq old ?\r) (eq new ?\r))
2905 (ding)
2906 (let ((string (format "\n%c" old))
2907 (buffer-read-only))
2908 (save-excursion
2909 (goto-char (point-min))
2910 (while (search-forward string nil t)
ee680b2b 2911 (if (if (= old ?\s)
a15a76f7
RS
2912 (save-match-data
2913 (dired-get-filename 'no-dir t))
2914 t)
2915 (subst-char-in-region (match-beginning 0)
2916 (match-end 0) old new)))))))
6482fcac 2917
534a6edf 2918(defun dired-unmark-all-marks ()
ee680b2b 2919 "Remove all marks from all files in the dired buffer."
b1ecd9c6
RS
2920 (interactive)
2921 (dired-unmark-all-files ?\r))
2922
8b87a301 2923(defun dired-unmark-all-files (mark &optional arg)
b602ba2f 2924 "Remove a specific mark (or any mark) from every file.
c60ee5e7 2925After this command, type the mark character to remove,
b602ba2f 2926or type RET to remove all marks.
3585916f 2927With prefix arg, query for each marked file.
492d2437 2928Type \\[help-command] at that time for help."
b602ba2f
RS
2929 (interactive "cRemove marks (RET means all): \nP")
2930 (save-excursion
2931 (let* ((count 0)
2932 buffer-read-only case-fold-search query
2933 (string (format "\n%c" mark))
2934 (help-form "\
8b87a301
RS
2935Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
2936`!' to unmark all remaining files with no more questions."))
b602ba2f
RS
2937 (goto-char (point-min))
2938 (while (if (eq mark ?\r)
2939 (re-search-forward dired-re-mark nil t)
2940 (search-forward string nil t))
2941 (if (or (not arg)
e9407052
RS
2942 (let ((file (dired-get-filename t t)))
2943 (and file
2944 (dired-query 'query "Unmark file `%s'? "
2945 file))))
b602ba2f 2946 (progn (subst-char-in-region (1- (point)) (point)
ee680b2b 2947 (preceding-char) ?\s)
b602ba2f
RS
2948 (setq count (1+ count)))))
2949 (message (if (= count 1) "1 mark removed"
2950 "%d marks removed")
2951 count))))
83fadedf 2952\f
492d2437 2953;; Logging failures operating on files, and showing the results.
84fc2cfa 2954
492d2437 2955(defvar dired-log-buffer "*Dired log*")
84fc2cfa 2956
492d2437
RS
2957(defun dired-why ()
2958 "Pop up a buffer with error log output from Dired.
2959A group of errors from a single command ends with a formfeed.
2960Thus, use \\[backward-page] to find the beginning of a group of errors."
2961 (interactive)
2962 (if (get-buffer dired-log-buffer)
2963 (let ((owindow (selected-window))
2964 (window (display-buffer (get-buffer dired-log-buffer))))
2965 (unwind-protect
6482fcac 2966 (progn
492d2437
RS
2967 (select-window window)
2968 (goto-char (point-max))
0b7bc76f
RS
2969 (forward-line -1)
2970 (backward-page 1)
2971 (recenter 0))
492d2437
RS
2972 (select-window owindow)))))
2973
2974(defun dired-log (log &rest args)
2975 ;; Log a message or the contents of a buffer.
2976 ;; If LOG is a string and there are more args, it is formatted with
2977 ;; those ARGS. Usually the LOG string ends with a \n.
c60ee5e7 2978 ;; End each bunch of errors with (dired-log t):
0b7bc76f
RS
2979 ;; this inserts the current time and buffer at the start of the page,
2980 ;; and \f (formfeed) at the end.
492d2437 2981 (let ((obuf (current-buffer)))
0b7bc76f
RS
2982 (with-current-buffer (get-buffer-create dired-log-buffer)
2983 (goto-char (point-max))
2984 (let ((inhibit-read-only t))
2985 (cond ((stringp log)
2986 (insert (if args
2987 (apply (function format) log args)
2988 log)))
2989 ((bufferp log)
88cb5d3c 2990 (insert-buffer-substring log))
0b7bc76f
RS
2991 ((eq t log)
2992 (backward-page 1)
2993 (unless (bolp)
2994 (insert "\n"))
2995 (insert (current-time-string)
2996 "\tBuffer `" (buffer-name obuf) "'\n")
2997 (goto-char (point-max))
2998 (insert "\f\n")))))))
492d2437
RS
2999
3000(defun dired-log-summary (string failures)
0b7bc76f
RS
3001 (if (= (length failures) 1)
3002 (message "%s"
3003 (with-current-buffer dired-log-buffer
3004 (goto-char (point-max))
3005 (backward-page 1)
3006 (if (eolp) (forward-line 1))
3007 (buffer-substring (point) (point-max))))
3008 (message (if failures "%s--type ? for details (%s)"
3009 "%s--type ? for details")
3010 string failures))
492d2437 3011 ;; Log a summary describing a bunch of errors.
0b7bc76f 3012 (dired-log (concat "\n" string "\n"))
492d2437 3013 (dired-log t))
83fadedf 3014\f
492d2437
RS
3015;;; Sorting
3016
3017;; Most ls can only sort by name or by date (with -t), nothing else.
3018;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
3019;; So anything that does not contain these is sort "by name".
3020
3021(defvar dired-ls-sorting-switches "SXU"
87ae59e3 3022 "String of `ls' switches \(single letters\) except \"t\" that influence sorting.
cfc8b264
EZ
3023
3024This indicates to Dired which option switches to watch out for because they
3025will change the sorting order behavior of `ls'.
3026
3027To change the default sorting order \(e.g. add a `-v' option\), see the
3028variable `dired-listing-switches'. To temporarily override the listing
3029format, use `\\[universal-argument] \\[dired]'.")
492d2437
RS
3030
3031(defvar dired-sort-by-date-regexp
3032 (concat "^-[^" dired-ls-sorting-switches
3033 "]*t[^" dired-ls-sorting-switches "]*$")
ee680b2b 3034 "Regexp recognized by Dired to set `by date' mode.")
492d2437
RS
3035
3036(defvar dired-sort-by-name-regexp
3037 (concat "^-[^t" dired-ls-sorting-switches "]+$")
ee680b2b 3038 "Regexp recognized by Dired to set `by name' mode.")
492d2437 3039
23fc67ea
RS
3040(defvar dired-sort-inhibit nil
3041 "Non-nil means the Dired sort command is disabled.
ee680b2b 3042The idea is to set this buffer-locally in special dired buffers.")
23fc67ea 3043
492d2437
RS
3044(defun dired-sort-set-modeline ()
3045 ;; Set modeline display according to dired-actual-switches.
3046 ;; Modeline display of "by name" or "by date" guarantees the user a
3047 ;; match with the corresponding regexps. Non-matching switches are
3048 ;; shown literally.
1d673d85 3049 (setq mode-name
492d2437
RS
3050 (let (case-fold-search)
3051 (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
1d673d85 3052 "Dired by name")
492d2437 3053 ((string-match dired-sort-by-date-regexp dired-actual-switches)
1d673d85 3054 "Dired by date")
492d2437 3055 (t
1d673d85 3056 (concat "Dired " dired-actual-switches)))))
45d8d39f 3057 (force-mode-line-update))
492d2437
RS
3058
3059(defun dired-sort-toggle-or-edit (&optional arg)
3060 "Toggle between sort by date/name and refresh the dired buffer.
3061With a prefix argument you can edit the current listing switches instead."
84fc2cfa 3062 (interactive "P")
23fc67ea 3063 (when dired-sort-inhibit
ee680b2b 3064 (error "Cannot sort this dired buffer"))
492d2437
RS
3065 (if arg
3066 (dired-sort-other
3067 (read-string "ls switches (must contain -l): " dired-actual-switches))
3068 (dired-sort-toggle)))
3069
3070(defun dired-sort-toggle ()
3071 ;; Toggle between sort by date/name. Reverts the buffer.
3072 (setq dired-actual-switches
3073 (let (case-fold-search)
7820b28f
RS
3074 (if (string-match " " dired-actual-switches)
3075 ;; New toggle scheme: add/remove a trailing " -t"
3076 (if (string-match " -t\\'" dired-actual-switches)
2b2059d8 3077 (substring dired-actual-switches 0 (match-beginning 0))
7820b28f
RS
3078 (concat dired-actual-switches " -t"))
3079 ;; old toggle scheme: look for some 't' switch and add/remove it
3080 (concat
3081 "-l"
83fadedf
DL
3082 (dired-replace-in-string (concat "[-lt"
3083 dired-ls-sorting-switches "]")
3084 ""
3085 dired-actual-switches)
7820b28f
RS
3086 (if (string-match (concat "[t" dired-ls-sorting-switches "]")
3087 dired-actual-switches)
3088 ""
3089 "t")))))
492d2437
RS
3090 (dired-sort-set-modeline)
3091 (revert-buffer))
3092
83fadedf 3093;; Some user code loads dired especially for this.
879fa8d0 3094;; Don't do that--use replace-regexp-in-string instead.
83fadedf
DL
3095(defun dired-replace-in-string (regexp newtext string)
3096 ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
3097 ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
3098 (let ((result "") (start 0) mb me)
3099 (while (string-match regexp string start)
3100 (setq mb (match-beginning 0)
3101 me (match-end 0)
3102 result (concat result (substring string start mb) newtext)
3103 start me))
3104 (concat result (substring string start))))
3105
492d2437 3106(defun dired-sort-other (switches &optional no-revert)
ee680b2b 3107 "Specify new `ls' SWITCHES for current dired buffer.
ff3d76aa
SM
3108Values matching `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp'
3109set the minor mode accordingly, others appear literally in the mode line.
3110With optional second arg NO-REVERT, don't refresh the listing afterwards."
e17dba1f 3111 (dired-sort-R-check switches)
492d2437 3112 (setq dired-actual-switches switches)
6cfd24f9 3113 (if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
492d2437 3114 (or no-revert (revert-buffer)))
e17dba1f 3115
5afea280
RS
3116(defvar dired-subdir-alist-pre-R nil
3117 "Value of `dired-subdir-alist' before -R switch added.")
75461997 3118(make-variable-buffer-local 'dired-subdir-alist-pre-R)
e17dba1f
GM
3119
3120(defun dired-sort-R-check (switches)
3121 "Additional processing of -R in ls option string SWITCHES.
3122Saves `dired-subdir-alist' when R is set and restores saved value
3123minus any directories explicitly deleted when R is cleared.
3124To be called first in body of `dired-sort-other', etc."
3125 (cond
3126 ((and (string-match "R" switches)
3127 (not (string-match "R" dired-actual-switches)))
3128 ;; Adding -R to ls switches -- save `dired-subdir-alist':
3129 (setq dired-subdir-alist-pre-R dired-subdir-alist))
3130 ((and (string-match "R" dired-actual-switches)
3131 (not (string-match "R" switches)))
3132 ;; Deleting -R from ls switches -- revert to pre-R subdirs
3133 ;; that are still present:
3134 (setq dired-subdir-alist
3135 (if dired-subdir-alist-pre-R
3136 (let (subdirs)
3137 (while dired-subdir-alist-pre-R
3138 (if (assoc (caar dired-subdir-alist-pre-R)
3139 dired-subdir-alist)
3140 ;; subdir still present...
3141 (setq subdirs
3142 (cons (car dired-subdir-alist-pre-R)
3143 subdirs)))
3144 (setq dired-subdir-alist-pre-R
3145 (cdr dired-subdir-alist-pre-R)))
3146 (reverse subdirs))
3147 ;; No pre-R subdir alist, so revert to main directory
3148 ;; listing:
3149 (list (car (reverse dired-subdir-alist))))))))
83fadedf 3150\f
133aad74
JD
3151
3152;;;; Drag and drop support
3153
fe02ba07
RS
3154(defcustom dired-recursive-copies nil
3155 "*Decide whether recursive copies are allowed.
3156nil means no recursive copies.
3157`always' means copy recursively without asking.
3158`top' means ask for each directory at top level.
3159Anything else means ask for each directory."
3160 :type '(choice :tag "Copy directories"
3161 (const :tag "No recursive copies" nil)
3162 (const :tag "Ask for each directory" t)
3163 (const :tag "Ask for each top directory only" top)
3164 (const :tag "Copy directories without asking" always))
3165 :group 'dired)
3166
133aad74 3167(defun dired-dnd-popup-notice ()
fcaed7ce
NR
3168 (message-box
3169 "Recursive copies not enabled.\nSee variable dired-recursive-copies."))
133aad74
JD
3170
3171
3172(defun dired-dnd-do-ask-action (uri)
3173 ;; No need to get actions and descriptions from the source,
3174 ;; we only have three actions anyway.
5553077c 3175 (let ((action (x-popup-menu
133aad74
JD
3176 t
3177 (list "What action?"
3178 (cons ""
3179 '(("Copy here" . copy)
3180 ("Move here" . move)
3181 ("Link here" . link)
3182 "--"
3183 ("Cancel" . nil)))))))
3184 (if action
3185 (dired-dnd-handle-local-file uri action)
3186 nil)))
3187
3188(defun dired-dnd-handle-local-file (uri action)
3189 "Copy, move or link a file to the dired directory.
3190URI is the file to handle, ACTION is one of copy, move, link or ask.
3191Ask means pop up a menu for the user to select one of copy, move or link."
3192 (require 'dired-aux)
361eee8f 3193 (let* ((from (dnd-get-local-file-name uri t))
133aad74
JD
3194 (to (if from (concat (dired-current-directory)
3195 (file-name-nondirectory from))
3196 nil)))
3197 (if from
3198 (cond ((or (eq action 'copy)
3199 (eq action 'private)) ; Treat private as copy.
3200
3201 ;; If copying a directory and dired-recursive-copies is nil,
3202 ;; dired-copy-file silently fails. Pop up a notice.
3203 (if (and (file-directory-p from)
3204 (not dired-recursive-copies))
3205 (dired-dnd-popup-notice)
3206 (progn
3207 (dired-copy-file from to 1)
3208 (dired-relist-entry to)
3209 action)))
3210
3211 ((eq action 'move)
3212 (dired-rename-file from to 1)
3213 (dired-relist-entry to)
3214 action)
3215
3216 ((eq action 'link)
3217 (make-symbolic-link from to 1)
3218 (dired-relist-entry to)
3219 action)
3220
3221 ((eq action 'ask)
3222 (dired-dnd-do-ask-action uri))
3223
3224 (t nil)))))
3225
3226(defun dired-dnd-handle-file (uri action)
3227 "Copy, move or link a file to the dired directory if it is a local file.
3228URI is the file to handle. If the hostname in the URI isn't local, do nothing.
3229ACTION is one of copy, move, link or ask.
3230Ask means pop up a menu for the user to select one of copy, move or link."
361eee8f 3231 (let ((local-file (dnd-get-local-file-uri uri)))
133aad74
JD
3232 (if local-file (dired-dnd-handle-local-file local-file action)
3233 nil)))
31b4c848
LH
3234\f
3235
3236;;;; Desktop support
3237
3238(eval-when-compile (require 'desktop))
3239
3240(defun dired-desktop-buffer-misc-data (desktop-dirname)
3241 "Auxiliary information to be saved in desktop file."
3242 (cons
3243 ;; Value of `dired-directory'.
3244 (if (consp dired-directory)
3245 ;; Directory name followed by list of files.
3246 (cons (desktop-file-name (car dired-directory) desktop-dirname)
3247 (cdr dired-directory))
9d9ee410 3248 ;; Directory name, optionally with shell wildcard.
31b4c848
LH
3249 (desktop-file-name dired-directory desktop-dirname))
3250 ;; Subdirectories in `dired-subdir-alist'.
3251 (cdr
3252 (nreverse
3253 (mapcar
3254 (function (lambda (f) (desktop-file-name (car f) desktop-dirname)))
3255 dired-subdir-alist)))))
133aad74 3256
31b4c848
LH
3257(defun dired-restore-desktop-buffer (desktop-buffer-file-name
3258 desktop-buffer-name
3259 desktop-buffer-misc)
3260 "Restore a dired buffer specified in a desktop file."
3261 ;; First element of `desktop-buffer-misc' is the value of `dired-directory'.
9d9ee410 3262 ;; This value is a directory name, optionally with shell wildcard or
31b4c848
LH
3263 ;; a directory name followed by list of files.
3264 (let* ((dired-dir (car desktop-buffer-misc))
3265 (dir (if (consp dired-dir) (car dired-dir) dired-dir)))
3266 (if (file-directory-p (file-name-directory dir))
3267 (progn
3268 (dired dired-dir)
3269 ;; The following elements of `desktop-buffer-misc' are the keys
3270 ;; from `dired-subdir-alist'.
3271 (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
3272 (current-buffer))
3273 (message "Desktop: Directory %s no longer exists." dir)
3274 (when desktop-missing-file-warning (sit-for 1))
3275 nil)))
133aad74 3276
9e7357b0
AS
3277(add-to-list 'desktop-buffer-mode-handlers
3278 '(dired-mode . dired-restore-desktop-buffer))
a515788d 3279
133aad74 3280\f
492d2437
RS
3281(if (eq system-type 'vax-vms)
3282 (load "dired-vms"))
84fc2cfa 3283
52041219
RS
3284(provide 'dired)
3285
57e15005
BF
3286(run-hooks 'dired-load-hook) ; for your customizations
3287
87ae59e3 3288;; arch-tag: e1af7a8f-691c-41a0-aac1-ddd4d3c87517
52041219 3289;;; dired.el ends here