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