Merged in CHARACTERS
[bpt/emacs.git] / lisp / dired.el
CommitLineData
c8472948 1;;; dired.el --- directory-browsing commands
52041219 2
ab67260b
RS
3;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
4
52041219
RS
5;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
6;; Version: 5.234
84fc2cfa
ER
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
52041219 12;; the Free Software Foundation; either version 2, or (at your option)
84fc2cfa
ER
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
52041219
RS
24;;; Commentary:
25
492d2437
RS
26;; Rewritten in 1990/1991 to add tree features, file marking and
27;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
28;; Finished up by rms in 1992.
29
52041219 30;;; Code:
492d2437 31
492d2437
RS
32;;; Customizable variables
33
34;;; The funny comments are for autoload.el, to automagically update
35;;; loaddefs.
84fc2cfa
ER
36
37;;;###autoload
492d2437
RS
38(defvar dired-listing-switches "-al"
39 "*Switches passed to `ls' for dired. MUST contain the `l' option.
40May contain all other options that don't contradict `-l';
41may contain even `F', `b', `i' and `s'.")
84fc2cfa 42
492d2437
RS
43; Don't use absolute paths as /bin should be in any PATH and people
44; may prefer /usr/local/gnu/bin or whatever. However, chown is
45; usually not in PATH.
46
47;;;###autoload
84fc2cfa 48(defvar dired-chown-program
194ff7c1
RS
49 (if (memq system-type '(hpux dgux usg-unix-v silicon-graphics-unix))
50 "chown" "/etc/chown")
492d2437
RS
51 "Name of chown command (usully `chown' or `/etc/chown').")
52
492d2437
RS
53;;;###autoload
54(defvar dired-ls-F-marks-symlinks nil
55 "*Informs dired about how `ls -lF' marks symbolic links.
c3554e95 56Set this to t if `insert-directory-program' with `-lF' marks the symbolic link
492d2437 57itself with a trailing @ (usually the case under Ultrix).
84fc2cfa 58
492d2437
RS
59Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
60nil (the default), if it gives `bar@ -> foo', set it to t.
61
62Dired checks if there is really a @ appended. Thus, if you have a
63marking `ls' program on one host and a non-marking on another host, and
64don't care about symbolic links which really end in a @, you can
65always set this variable to t.")
66
67;;;###autoload
68(defvar dired-trivial-filenames "^\\.\\.?$\\|^#"
69 "*Regexp of files to skip when finding first file of a directory.
70A value of nil means move to the subdir line.
71A value of t means move to first file.")
72
73;;;###autoload
74(defvar dired-keep-marker-rename t
75 ;; Use t as default so that moved files "take their markers with them".
76 "*Controls marking of renamed files.
77If t, files keep their previous marks when they are renamed.
78If a character, renamed files (whether previously marked or not)
79are afterward marked with that character.")
80
81;;;###autoload
82(defvar dired-keep-marker-copy ?C
83 "*Controls marking of copied files.
84If t, copied files are marked if and as the corresponding original files were.
85If a character, copied files are unconditionally marked with that character.")
86
87;;;###autoload
88(defvar dired-keep-marker-hardlink ?H
89 "*Controls marking of newly made hard links.
90If t, they are marked if and as the files linked to were marked.
91If a character, new links are unconditionally marked with that character.")
92
93;;;###autoload
94(defvar dired-keep-marker-symlink ?Y
95 "*Controls marking of newly made symbolic links.
96If t, they are marked if and as the files linked to were marked.
97If a character, new links are unconditionally marked with that character.")
98
99;;;###autoload
100(defvar dired-dwim-target nil
101 "*If non-nil, dired tries to guess a default target directory.
102This means: if there is a dired buffer displayed in the next window,
103use its current subdir, instead of the current subdir of this dired buffer.
104
105The target is used in the prompt for file copy, rename etc.")
106
107;;;###autoload
108(defvar dired-copy-preserve-time t
109 "*If non-nil, Dired preserves the last-modified time in a file copy.
110\(This works on only some systems.)")
111
112;;; Hook variables
113
114(defvar dired-load-hook nil
115 "Run after loading dired.
116You can customize key bindings or load extensions with this.")
117
118(defvar dired-mode-hook nil
119 "Run at the very end of dired-mode.")
120
121(defvar dired-before-readin-hook nil
122 "This hook is run before a dired buffer is read in (created or reverted).")
123
124(defvar dired-after-readin-hook nil
125 "Hook run after each time a file or directory is read by Dired.
126After each listing of a file or directory, this hook is run
127with the buffer narrowed to the listing.")
128;; Note this can't simply be run inside function `dired-ls' as the hook
129;; functions probably depend on the dired-subdir-alist to be OK.
130
131;;; Internal variables
132
133(defvar dired-marker-char ?* ; the answer is 42
134 ;; so that you can write things like
135 ;; (let ((dired-marker-char ?X))
136 ;; ;; great code using X markers ...
137 ;; )
138 ;; For example, commands operating on two sets of files, A and B.
139 ;; Or marking files with digits 0-9. This could implicate
140 ;; concentric sets or an order for the marked files.
141 ;; The code depends on dynamic scoping on the marker char.
142 "In Dired, the current mark character.
143This is what the `do' commands look for and what the `mark' commands store.")
144
145(defvar dired-del-marker ?D
146 "Character used to flag files for deletion.")
147
148(defvar dired-shrink-to-fit
ab67260b
RS
149 t
150;; I see no reason ever to make this nil -- rms.
151;; (> baud-rate search-slow-speed)
492d2437
RS
152 "Non-nil means Dired shrinks the display buffer to fit the marked files.")
153
154(defvar dired-flagging-regexp nil);; Last regexp used to flag files.
155
ab67260b
RS
156(defvar dired-file-version-alist)
157
492d2437
RS
158(defvar dired-directory nil
159 "The directory name or shell wildcard that was used as argument to `ls'.
160Local to each dired buffer.")
161
162(defvar dired-actual-switches nil
163 "The value of `dired-listing-switches' used to make this buffer's text.")
164
165(defvar dired-re-inode-size "[0-9 \t]*"
166 "Regexp for optional initial inode and file size as made by `ls -i -s'.")
167
168;; These regexps must be tested at beginning-of-line, but are also
169;; used to search for next matches, so neither omitting "^" nor
170;; replacing "^" by "\n" (to make it slightly faster) will work.
171
172(defvar dired-re-mark "^[^ \n]")
173;; "Regexp matching a marked line.
174;; Important: the match ends just after the marker."
175(defvar dired-re-maybe-mark "^. ")
176(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
177(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
178(defvar dired-re-exe;; match ls permission string of an executable file
179 (mapconcat (function
180 (lambda (x)
181 (concat dired-re-maybe-mark dired-re-inode-size x)))
182 '("-[-r][-w][xs][-r][-w].[-r][-w]."
183 "-[-r][-w].[-r][-w][xs][-r][-w]."
184 "-[-r][-w].[-r][-w].[-r][-w][xst]")
185 "\\|"))
186(defvar dired-re-dot "^.* \\.\\.?$")
187
188(defvar dired-subdir-alist nil
189 "Association list of subdirectories and their buffer positions.
190Each subdirectory has an element: (DIRNAME . STARTMARKER).
7b2469ae
RS
191The order of elements is the reverse of the order in the buffer.
192In simple cases, this list contains one element.")
492d2437
RS
193
194(defvar dired-subdir-regexp "^. \\([^ \n\r]+\\)\\(:\\)[\n\r]"
195 "Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
196Subexpression 1 is the subdirectory proper, no trailing colon.
197The match starts at the beginning of the line and ends after the end
198of the line (\\n or \\r).
199Subexpression 2 must end right before the \\n or \\r.")
200
201\f
202;;; Macros must be defined before they are used, for the byte compiler.
203
204;; Mark all files for which CONDITION evals to non-nil.
205;; CONDITION is evaluated on each line, with point at beginning of line.
206;; MSG is a noun phrase for the type of files being marked.
207;; It should end with a noun that can be pluralized by adding `s'.
208;; Return value is the number of files marked, or nil if none were marked.
209(defmacro dired-mark-if (predicate msg)
210 (` (let (buffer-read-only count)
211 (save-excursion
212 (setq count 0)
213 (if (, msg) (message "Marking %ss..." (, msg)))
214 (goto-char (point-min))
215 (while (not (eobp))
216 (if (, predicate)
217 (progn
218 (delete-char 1)
219 (insert dired-marker-char)
220 (setq count (1+ count))))
221 (forward-line 1))
222 (if (, msg) (message "%s %s%s %s%s."
223 count
224 (, msg)
225 (dired-plural-s count)
226 (if (eq dired-marker-char ?\040) "un" "")
227 (if (eq dired-marker-char dired-del-marker)
228 "flagged" "marked"))))
229 (and (> count 0) count))))
230
231(defmacro dired-map-over-marks (body arg &optional show-progress)
232;; "Macro: Perform BODY with point somewhere on each marked line
233;;and return a list of BODY's results.
234;;If no marked file could be found, execute BODY on the current line.
235;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
236;; files instead of the marked files.
237;; In that case point is dragged along. This is so that commands on
238;; the next ARG (instead of the marked) files can be chained easily.
239;; If ARG is otherwise non-nil, use current file instead.
240;;If optional third arg SHOW-PROGRESS evaluates to non-nil,
241;; redisplay the dired buffer after each file is processed.
242;;No guarantee is made about the position on the marked line.
243;; BODY must ensure this itself if it depends on this.
244;;Search starts at the beginning of the buffer, thus the car of the list
245;; corresponds to the line nearest to the buffer's bottom. This
246;; is also true for (positive and negative) integer values of ARG.
247;;BODY should not be too long as it is expanded four times."
248;;
249;;Warning: BODY must not add new lines before point - this may cause an
250;;endless loop.
251;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
252 (` (prog1
253 (let (buffer-read-only case-fold-search found results)
254 (if (, arg)
255 (if (integerp (, arg))
256 (progn;; no save-excursion, want to move point.
257 (dired-repeat-over-lines
258 (, arg)
259 (function (lambda ()
260 (if (, show-progress) (sit-for 0))
261 (setq results (cons (, body) results)))))
262 (if (< (, arg) 0)
263 (nreverse results)
264 results))
265 ;; non-nil, non-integer ARG means use current file:
266 (list (, body)))
267 (let ((regexp (dired-marker-regexp)) next-position)
268 (save-excursion
269 (goto-char (point-min))
270 ;; remember position of next marked file before BODY
271 ;; can insert lines before the just found file,
272 ;; confusing us by finding the same marked file again
273 ;; and again and...
274 (setq next-position (and (re-search-forward regexp nil t)
275 (point-marker))
276 found (not (null next-position)))
277 (while next-position
278 (goto-char next-position)
279 (if (, show-progress) (sit-for 0))
280 (setq results (cons (, body) results))
281 ;; move after last match
282 (goto-char next-position)
283 (forward-line 1)
284 (set-marker next-position nil)
285 (setq next-position (and (re-search-forward regexp nil t)
286 (point-marker)))))
287 (if found
288 results
289 (list (, body))))))
290 ;; save-excursion loses, again
291 (dired-move-to-filename))))
292
293(defun dired-get-marked-files (&optional localp arg)
294 "Return the marked files' names as list of strings.
295The list is in the same order as the buffer, that is, the car is the
296 first marked file.
297Values returned are normally absolute pathnames.
298Optional arg LOCALP as in `dired-get-filename'.
299Optional second argument ARG forces to use other files. If ARG is an
300 integer, use the next ARG files. If ARG is otherwise non-nil, use
301 current file. Usually ARG comes from the current prefix arg."
84fc2cfa 302 (save-excursion
492d2437 303 (nreverse (dired-map-over-marks (dired-get-filename localp) arg))))
84fc2cfa 304
492d2437
RS
305\f
306;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
307;; other special applications.
492d2437
RS
308\f
309;; The dired command
310
311(defun dired-read-dir-and-switches (str)
312 ;; For use in interactive.
313 (reverse (list
314 (if current-prefix-arg
315 (read-string "Dired listing switches: "
316 dired-listing-switches))
317 (read-file-name (format "Dired %s(directory): " str)
318 nil default-directory nil))))
84fc2cfa 319
492d2437 320;;;###autoload (define-key ctl-x-map "d" 'dired)
84fc2cfa 321;;;###autoload
492d2437 322(defun dired (dirname &optional switches)
84fc2cfa 323 "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
492d2437
RS
324Optional second argument SWITCHES specifies the `ls' options used.
325\(Interactively, use a prefix argument to be able to specify SWITCHES.)
326Dired displays a list of files in DIRNAME (which may also have
327 shell wildcards appended to select certain files).
52041219 328\\<dired-mode-map>\
492d2437 329You can move around in it with the usual commands.
52041219 330You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by
492d2437
RS
331 typing \\[dired-do-flagged-delete].
332Type \\[describe-mode] after entering dired for more info.
84fc2cfa 333
492d2437
RS
334If DIRNAME is already in a dired buffer, that buffer is used without refresh."
335 ;; Cannot use (interactive "D") because of wildcards.
336 (interactive (dired-read-dir-and-switches ""))
337 (switch-to-buffer (dired-noselect dirname switches)))
338
339;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
84fc2cfa 340;;;###autoload
492d2437 341(defun dired-other-window (dirname &optional switches)
84fc2cfa 342 "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
492d2437
RS
343 (interactive (dired-read-dir-and-switches "in other window "))
344 (switch-to-buffer-other-window (dired-noselect dirname switches)))
84fc2cfa
ER
345
346;;;###autoload
492d2437 347(defun dired-noselect (dirname &optional switches)
84fc2cfa
ER
348 "Like `dired' but returns the dired buffer as value, does not select it."
349 (or dirname (setq dirname default-directory))
492d2437
RS
350 ;; This loses the distinction between "/foo/*/" and "/foo/*" that
351 ;; some shells make:
84fc2cfa
ER
352 (setq dirname (expand-file-name (directory-file-name dirname)))
353 (if (file-directory-p dirname)
354 (setq dirname (file-name-as-directory dirname)))
492d2437
RS
355 (dired-internal-noselect dirname switches))
356
357;; Separate function from dired-noselect for the sake of dired-vms.el.
358(defun dired-internal-noselect (dirname &optional switches)
359 ;; If there is an existing dired buffer for DIRNAME, just leave
360 ;; buffer as it is (don't even call dired-revert).
361 ;; This saves time especially for deep trees or with ange-ftp.
362 ;; The user can type `g'easily, and it is more consistent with find-file.
363 ;; But if SWITCHES are given they are probably different from the
364 ;; buffer's old value, so call dired-sort-other, which does
365 ;; revert the buffer.
366 ;; A pity we can't possibly do "Directory has changed - refresh? "
367 ;; like find-file does.
368 (let* ((buffer (dired-find-buffer-nocreate dirname))
369 ;; note that buffer already is in dired-mode, if found
370 (new-buffer-p (not buffer))
371 (old-buf (current-buffer)))
372 (or buffer
373 (let ((default-major-mode 'fundamental-mode))
374 ;; We don't want default-major-mode to run hooks and set auto-fill
375 ;; or whatever, now that dired-mode does not
376 ;; kill-all-local-variables any longer.
377 (setq buffer (create-file-buffer (directory-file-name dirname)))))
378 (set-buffer buffer)
379 (if (not new-buffer-p) ; existing buffer ...
380 (if switches ; ... but new switches
381 (dired-sort-other switches)) ; this calls dired-revert
382 ;; Else a new buffer
383 (setq default-directory (if (file-directory-p dirname)
384 dirname
385 (file-name-directory dirname)))
386 (or switches (setq switches dired-listing-switches))
387 (dired-mode dirname switches)
388 ;; default-directory and dired-actual-switches are set now
389 ;; (buffer-local), so we can call dired-readin:
390 (let ((failed t))
391 (unwind-protect
392 (progn (dired-readin dirname buffer)
393 (setq failed nil))
394 ;; dired-readin can fail if parent directories are inaccessible.
395 ;; Don't leave an empty buffer around in that case.
396 (if failed (kill-buffer buffer))))
397 ;; No need to narrow since the whole buffer contains just
398 ;; dired-readin's output, nothing else. The hook can
399 ;; successfully use dired functions (e.g. dired-get-filename)
400 ;; as the subdir-alist has been built in dired-readin.
401 (run-hooks 'dired-after-readin-hook)
402 (goto-char (point-min))
403 (dired-initial-position dirname))
404 (set-buffer old-buf)
84fc2cfa
ER
405 buffer))
406
492d2437
RS
407;; This differs from dired-buffers-for-dir in that it does not consider
408;; subdirs of default-directory and searches for the first match only
409(defun dired-find-buffer-nocreate (dirname)
410 (let (found (blist (buffer-list)))
411 (while blist
412 (save-excursion
413 (set-buffer (car blist))
414 (if (and (eq major-mode 'dired-mode)
415 (equal dired-directory dirname))
416 (setq found (car blist)
417 blist nil)
418 (setq blist (cdr blist)))))
419 found))
420
421\f
422;; Read in a new dired buffer
423
424;; dired-readin differs from dired-insert-subdir in that it accepts
425;; wildcards, erases the buffer, and builds the subdir-alist anew
426;; (including making it buffer-local and clearing it first).
427(defun dired-readin (dirname buffer)
428 ;; default-directory and dired-actual-switches must be buffer-local
429 ;; and initialized by now.
430 ;; Thus we can test (equal default-directory dirname) instead of
431 ;; (file-directory-p dirname) and save a filesystem transaction.
432 ;; Also, we can run this hook which may want to modify the switches
433 ;; based on default-directory, e.g. with ange-ftp to a SysV host
434 ;; where ls won't understand -Al switches.
435 (setq dirname (expand-file-name dirname))
436 (run-hooks 'dired-before-readin-hook)
437 (save-excursion
438 (message "Reading directory %s..." dirname)
439 (set-buffer buffer)
440 (let (buffer-read-only (failed t))
441 (widen)
442 (erase-buffer)
443 (dired-readin-insert dirname)
444 (indent-rigidly (point-min) (point-max) 2)
445 ;; We need this to make the root dir have a header line as all
446 ;; other subdirs have:
447 (goto-char (point-min))
448 (dired-insert-headerline default-directory)
449 ;; can't run dired-after-readin-hook here, it may depend on the subdir
450 ;; alist to be OK.
451 )
452 (message "Reading directory %s...done" dirname)
453 (set-buffer-modified-p nil)
454 ;; Must first make alist buffer local and set it to nil because
455 ;; dired-build-subdir-alist will call dired-clear-alist first
456 (set (make-local-variable 'dired-subdir-alist) nil)
457 (dired-build-subdir-alist)))
458
459;; Subroutines of dired-readin
460
461(defun dired-readin-insert (dirname)
462 ;; Just insert listing for DIRNAME, assuming a clean buffer.
463 (if (equal default-directory dirname);; i.e., (file-directory-p dirname)
c3554e95 464 (insert-directory dirname dired-actual-switches nil t)
492d2437
RS
465 (if (not (file-readable-p
466 (directory-file-name (file-name-directory dirname))))
467 (error "Directory %s inaccessible or nonexistent" dirname)
468 ;; else assume it contains wildcards:
c3554e95 469 (insert-directory dirname dired-actual-switches t)
492d2437
RS
470 (save-excursion;; insert wildcard instead of total line:
471 (goto-char (point-min))
472 (insert "wildcard " (file-name-nondirectory dirname) "\n")))))
473
474(defun dired-insert-headerline (dir);; also used by dired-insert-subdir
475 ;; Insert DIR's headerline with no trailing slash, exactly like ls
476 ;; would, and put cursor where dired-build-subdir-alist puts subdir
477 ;; boundaries.
478 (save-excursion (insert " " (directory-file-name dir) ":\n")))
479
480\f
481;; Reverting a dired buffer
482
84fc2cfa 483(defun dired-revert (&optional arg noconfirm)
492d2437
RS
484 ;; Reread the dired buffer. Must also be called after
485 ;; dired-actual-switches have changed.
486 ;; Should not fail even on completely garbaged buffers.
487 ;; Preserves old cursor, marks/flags, hidden-p.
488 (widen) ; just in case user narrowed
84fc2cfa 489 (let ((opoint (point))
492d2437
RS
490 (ofile (dired-get-filename nil t))
491 (mark-alist nil) ; save marked files
492 (hidden-subdirs (dired-remember-hidden))
493 (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
494 (case-fold-search nil) ; we check for upper case ls flags
495 buffer-read-only)
496 (goto-char (point-min))
497 (setq mark-alist;; only after dired-remember-hidden since this unhides:
498 (dired-remember-marks (point-min) (point-max)))
499 ;; treat top level dir extra (it may contain wildcards)
715984d3 500 (dired-uncache dired-directory)
84fc2cfa 501 (dired-readin dired-directory (current-buffer))
492d2437
RS
502 (let ((dired-after-readin-hook nil))
503 ;; don't run that hook for each subdir...
504 (dired-insert-old-subdirs old-subdir-alist))
505 (dired-mark-remembered mark-alist) ; mark files that were marked
506 ;; ... run the hook for the whole buffer, and only after markers
507 ;; have been reinserted (else omitting in dired-x would omit marked files)
508 (run-hooks 'dired-after-readin-hook) ; no need to narrow
509 (or (and ofile (dired-goto-file ofile)) ; move cursor to where it
510 (goto-char opoint)) ; was before
84fc2cfa 511 (dired-move-to-filename)
492d2437
RS
512 (save-excursion ; hide subdirs that were hidden
513 (mapcar (function (lambda (dir)
514 (if (dired-goto-subdir dir)
515 (dired-hide-subdir 1))))
516 hidden-subdirs)))
517 ;; outside of the let scope
518;;; Might as well not override the user if the user changed this.
519;;; (setq buffer-read-only t)
520 )
521
522;; Subroutines of dired-revert
523;; Some of these are also used when inserting subdirs.
524
525(defun dired-remember-marks (beg end)
526 ;; Return alist of files and their marks, from BEG to END.
527 (if selective-display ; must unhide to make this work.
528 (let (buffer-read-only)
529 (subst-char-in-region beg end ?\r ?\n)))
530 (let (fil chr alist)
531 (save-excursion
532 (goto-char beg)
533 (while (re-search-forward dired-re-mark end t)
534 (if (setq fil (dired-get-filename nil t))
535 (setq chr (preceding-char)
536 alist (cons (cons fil chr) alist)))))
537 alist))
538
539;; Mark all files remembered in ALIST.
540;; Each element of ALIST looks like (FILE . MARKERCHAR).
541(defun dired-mark-remembered (alist)
542 (let (elt fil chr)
543 (while alist
544 (setq elt (car alist)
545 alist (cdr alist)
546 fil (car elt)
547 chr (cdr elt))
548 (if (dired-goto-file fil)
549 (save-excursion
550 (beginning-of-line)
551 (delete-char 1)
552 (insert chr))))))
553
554;; Return a list of names of subdirs currently hidden.
555(defun dired-remember-hidden ()
556 (let ((l dired-subdir-alist) dir pos result)
557 (while l
558 (setq dir (car (car l))
559 pos (cdr (car l))
560 l (cdr l))
561 (goto-char pos)
562 (skip-chars-forward "^\r\n")
52041219 563 (if (eq (following-char) ?\r)
492d2437
RS
564 (setq result (cons dir result))))
565 result))
566
567;; Try to insert all subdirs that were displayed before,
568;; according to the former subdir alist OLD-SUBDIR-ALIST.
569(defun dired-insert-old-subdirs (old-subdir-alist)
570 (or (string-match "R" dired-actual-switches)
571 (let (elt dir)
572 (while old-subdir-alist
573 (setq elt (car old-subdir-alist)
574 old-subdir-alist (cdr old-subdir-alist)
575 dir (car elt))
576 (condition-case ()
715984d3
RS
577 (progn
578 (dired-uncache dir)
579 (dired-insert-subdir dir))
492d2437 580 (error nil))))))
715984d3
RS
581
582;; Remove directory DIR from any directory cache.
583(defun dired-uncache (dir)
5dbfdacd 584 (let ((handler (find-file-name-handler dir)))
715984d3
RS
585 (if handler
586 (funcall handler 'dired-uncache dir))))
492d2437
RS
587\f
588;; dired mode key bindings and initialization
84fc2cfa
ER
589
590(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
591(if dired-mode-map
592 nil
492d2437
RS
593 ;; Force `f' rather than `e' in the mode doc:
594 (fset 'dired-advertised-find-file 'dired-find-file)
595 ;; This looks ugly when substitute-command-keys uses C-d instead d:
596 ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
597
84fc2cfa
ER
598 (setq dired-mode-map (make-keymap))
599 (suppress-keymap dired-mode-map)
492d2437 600 ;; Commands to mark or flag certain categories of files
84fc2cfa 601 (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
492d2437 602 (define-key dired-mode-map "*" 'dired-mark-executables)
84fc2cfa 603 (define-key dired-mode-map "." 'dired-clean-directory)
492d2437
RS
604 (define-key dired-mode-map "/" 'dired-mark-directories)
605 (define-key dired-mode-map "@" 'dired-mark-symlinks)
606 (define-key dired-mode-map "~" 'dired-flag-backup-files)
6482fcac 607 ;; Upper case keys (except !) for operating on the marked files
492d2437
RS
608 (define-key dired-mode-map "C" 'dired-do-copy)
609 (define-key dired-mode-map "B" 'dired-do-byte-compile)
610 (define-key dired-mode-map "D" 'dired-do-delete)
611 (define-key dired-mode-map "G" 'dired-do-chgrp)
612 (define-key dired-mode-map "H" 'dired-do-hardlink)
613 (define-key dired-mode-map "L" 'dired-do-load)
614 (define-key dired-mode-map "M" 'dired-do-chmod)
615 (define-key dired-mode-map "O" 'dired-do-chown)
616 (define-key dired-mode-map "P" 'dired-do-print)
617 (define-key dired-mode-map "R" 'dired-do-rename)
618 (define-key dired-mode-map "S" 'dired-do-symlink)
619 (define-key dired-mode-map "X" 'dired-do-shell-command)
620 (define-key dired-mode-map "Z" 'dired-do-compress)
621 (define-key dired-mode-map "!" 'dired-do-shell-command)
622 ;; Comparison commands
623 (define-key dired-mode-map "=" 'dired-diff)
624 (define-key dired-mode-map "\M-=" 'dired-backup-diff)
625 ;; Tree Dired commands
626 (define-key dired-mode-map "\M-\C-?" 'dired-unmark-all-files)
627 (define-key dired-mode-map "\M-\C-d" 'dired-tree-down)
628 (define-key dired-mode-map "\M-\C-u" 'dired-tree-up)
629 (define-key dired-mode-map "\M-\C-n" 'dired-next-subdir)
630 (define-key dired-mode-map "\M-\C-p" 'dired-prev-subdir)
631 ;; move to marked files
632 (define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
633 (define-key dired-mode-map "\M-}" 'dired-next-marked-file)
492d2437
RS
634 ;; Make all regexp commands share a `%' prefix:
635 (fset 'dired-regexp-prefix (make-sparse-keymap))
636 (define-key dired-mode-map "%" 'dired-regexp-prefix)
637 (define-key dired-mode-map "%u" 'dired-upcase)
638 (define-key dired-mode-map "%l" 'dired-downcase)
639 (define-key dired-mode-map "%d" 'dired-flag-files-regexp)
640 (define-key dired-mode-map "%m" 'dired-mark-files-regexp)
641 (define-key dired-mode-map "%r" 'dired-do-rename-regexp)
642 (define-key dired-mode-map "%C" 'dired-do-copy-regexp)
643 (define-key dired-mode-map "%H" 'dired-do-hardlink-regexp)
644 (define-key dired-mode-map "%R" 'dired-do-rename-regexp)
645 (define-key dired-mode-map "%S" 'dired-do-symlink-regexp)
646 ;; Lower keys for commands not operating on all the marked files
6482fcac 647 (define-key dired-mode-map "c" 'dired-change-marks)
492d2437
RS
648 (define-key dired-mode-map "d" 'dired-flag-file-deletion)
649 (define-key dired-mode-map "e" 'dired-find-file)
650 (define-key dired-mode-map "f" 'dired-advertised-find-file)
651 (define-key dired-mode-map "g" 'revert-buffer)
84fc2cfa 652 (define-key dired-mode-map "h" 'describe-mode)
492d2437 653 (define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
6482fcac 654 (define-key dired-mode-map "k" 'dired-do-kill-lines)
492d2437
RS
655 (define-key dired-mode-map "l" 'dired-do-redisplay)
656 (define-key dired-mode-map "m" 'dired-mark)
657 (define-key dired-mode-map "n" 'dired-next-line)
658 (define-key dired-mode-map "o" 'dired-find-file-other-window)
ab67260b 659 (define-key dired-mode-map "\C-o" 'dired-display-file)
492d2437
RS
660 (define-key dired-mode-map "p" 'dired-previous-line)
661 (define-key dired-mode-map "q" 'dired-quit)
662 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit)
663 (define-key dired-mode-map "u" 'dired-unmark)
664 (define-key dired-mode-map "v" 'dired-view-file)
665 (define-key dired-mode-map "x" 'dired-do-flagged-delete)
666 (define-key dired-mode-map "+" 'dired-create-directory)
667 ;; moving
668 (define-key dired-mode-map "<" 'dired-prev-dirline)
669 (define-key dired-mode-map ">" 'dired-next-dirline)
670 (define-key dired-mode-map "^" 'dired-up-directory)
84fc2cfa
ER
671 (define-key dired-mode-map " " 'dired-next-line)
672 (define-key dired-mode-map "\C-n" 'dired-next-line)
673 (define-key dired-mode-map "\C-p" 'dired-previous-line)
492d2437
RS
674 ;; hiding
675 (define-key dired-mode-map "$" 'dired-hide-subdir)
676 (define-key dired-mode-map "\M-$" 'dired-hide-all)
677 ;; misc
678 (define-key dired-mode-map "?" 'dired-summary)
679 (define-key dired-mode-map "\177" 'dired-unmark-backward)
680 (define-key dired-mode-map "\C-_" 'dired-undo)
681 (define-key dired-mode-map "\C-xu" 'dired-undo)
682 )
84fc2cfa 683
492d2437
RS
684(or (member '(dired-sort-mode dired-sort-mode) minor-mode-alist)
685 ;; Test whether this has already been done in case dired is reloaded
686 ;; There may be several elements with dired-sort-mode as car.
687 (setq minor-mode-alist
688 (cons '(dired-sort-mode dired-sort-mode)
689 ;; dired-sort-mode is nil outside dired
690 minor-mode-alist)))
691\f
84fc2cfa
ER
692;; Dired mode is suitable only for specially formatted data.
693(put 'dired-mode 'mode-class 'special)
694
492d2437
RS
695(defun dired-mode (&optional dirname switches)
696 "\
697Mode for \"editing\" directory listings.
698In dired, you are \"editing\" a list of the files in a directory and
699 \(optionally) its subdirectories, in the format of `ls -lR'.
700 Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
701\"Editing\" means that you can run shell commands on files, visit,
702 compress, load or byte-compile them, change their file attributes
703 and insert subdirectories into the same buffer. You can \"mark\"
704 files for later commands or \"flag\" them for deletion, either file
705 by file or all files matching certain criteria.
706You can move using the usual cursor motion commands.\\<dired-mode-map>
707Letters no longer insert themselves. Digits are prefix arguments.
708Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion.
709Type \\[dired-mark] to Mark a file or subdirectory for later commands.
710 Most commands operate on the marked files and use the current file
711 if no files are marked. Use a numeric prefix argument to operate on
712 the next ARG (or previous -ARG if ARG<0) files, or just `1'
713 to operate on the current file only. Prefix arguments override marks.
714 Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
715 to see why something went wrong.
716Type \\[dired-unmark] to Unmark a file or all files of a subdirectory.
717Type \\[dired-unmark-backward] to back up one line and unflag.
718Type \\[dired-do-flagged-delete] to eXecute the deletions requested.
719Type \\[dired-advertised-find-file] to Find the current line's file
720 (or dired it in another buffer, if it is a directory).
721Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
722Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
723Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
724Type \\[dired-do-copy] to Copy files.
725Type \\[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the `ls' switches.
726Type \\[revert-buffer] to read all currently expanded directories again.
727 This retains all marks and hides subdirs again that were hidden before.
728SPC and DEL can be used to move down and up by lines.
729
730If dired ever gets confused, you can either type \\[revert-buffer] \
731to read the
732directories again, type \\[dired-do-redisplay] \
733to relist a single or the marked files or a
734subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
735again for the directory tree.
736
737Customization variables (rename this buffer and type \\[describe-variable] on each line
738for more info):
739
740 dired-listing-switches
741 dired-trivial-filenames
742 dired-shrink-to-fit
743 dired-marker-char
744 dired-del-marker
745 dired-keep-marker-rename
746 dired-keep-marker-copy
747 dired-keep-marker-hardlink
748 dired-keep-marker-symlink
749
750Hooks (use \\[describe-variable] to see their documentation):
751
752 dired-before-readin-hook
753 dired-after-readin-hook
754 dired-mode-hook
755 dired-load-hook
756
757Keybindings:
84fc2cfa 758\\{dired-mode-map}"
492d2437
RS
759 ;; Not to be called interactively (e.g. dired-directory will be set
760 ;; to default-directory, which is wrong with wildcards).
84fc2cfa 761 (kill-all-local-variables)
84fc2cfa 762 (use-local-map dired-mode-map)
492d2437
RS
763 (dired-advertise) ; default-directory is already set
764 (setq major-mode 'dired-mode
765 mode-name "Dired"
766 case-fold-search nil
767 buffer-read-only t
768 selective-display t ; for subdirectory hiding
769 mode-line-buffer-identification '("Dired: %17b"))
770 (set (make-local-variable 'revert-buffer-function)
771 (function dired-revert))
772 (set (make-local-variable 'page-delimiter)
773 "\n\n")
774 (set (make-local-variable 'dired-directory)
775 (or dirname default-directory))
776 ;; list-buffers uses this to display the dir being edited in this buffer.
777 (set (make-local-variable 'list-buffers-directory)
778 dired-directory)
779 (set (make-local-variable 'dired-actual-switches)
780 (or switches dired-listing-switches))
781 (make-local-variable 'dired-sort-mode)
782 (dired-sort-other dired-actual-switches t)
84fc2cfa
ER
783 (run-hooks 'dired-mode-hook))
784\f
492d2437 785;; Ideosyncratic dired commands that don't deal with marks.
84fc2cfa 786
492d2437
RS
787(defun dired-quit ()
788 "Bury the current dired buffer."
789 (interactive)
790 (bury-buffer))
84fc2cfa
ER
791
792(defun dired-summary ()
492d2437 793 "Summarize basic Dired commands and show recent Dired errors."
84fc2cfa 794 (interactive)
492d2437 795 (dired-why)
84fc2cfa
ER
796 ;>> this should check the key-bindings and use substitute-command-keys if non-standard
797 (message
492d2437 798 "d-elete, u-ndelete, x-punge, f-ind, o-ther window, r-ename, C-opy, h-elp"))
84fc2cfa 799
492d2437
RS
800(defun dired-undo ()
801 "Undo in a dired buffer.
802This doesn't recover lost files, it just undoes changes in the buffer itself.
803You can use it to recover marks, killed lines or subdirs.
804In the latter case, you have to do \\[dired-build-subdir-alist] to
805parse the buffer again."
806 (interactive)
807 (let (buffer-read-only)
808 (undo)))
84fc2cfa
ER
809
810(defun dired-next-line (arg)
811 "Move down lines then position at filename.
812Optional prefix ARG says how many lines to move; default is one line."
813 (interactive "p")
814 (next-line arg)
815 (dired-move-to-filename))
816
817(defun dired-previous-line (arg)
818 "Move up lines then position at filename.
819Optional prefix ARG says how many lines to move; default is one line."
820 (interactive "p")
821 (previous-line arg)
822 (dired-move-to-filename))
823
492d2437
RS
824(defun dired-next-dirline (arg &optional opoint)
825 "Goto ARG'th next directory file line."
826 (interactive "p")
827 (or opoint (setq opoint (point)))
828 (if (if (> arg 0)
829 (re-search-forward dired-re-dir nil t arg)
830 (beginning-of-line)
831 (re-search-backward dired-re-dir nil t (- arg)))
832 (dired-move-to-filename) ; user may type `i' or `f'
833 (goto-char opoint)
834 (error "No more subdirectories")))
835
836(defun dired-prev-dirline (arg)
837 "Goto ARG'th previous directory file line."
838 (interactive "p")
839 (dired-next-dirline (- arg)))
840
84fc2cfa 841(defun dired-up-directory ()
492d2437
RS
842 "Run dired on parent directory of current directory.
843Find the parent directory either in this buffer or another buffer.
844Creates a buffer if necessary."
84fc2cfa 845 (interactive)
492d2437
RS
846 (let* ((dir (dired-current-directory))
847 (up (file-name-directory (directory-file-name dir))))
848 (or (dired-goto-file (directory-file-name dir))
7b2469ae
RS
849 ;; Only try dired-goto-subdir if buffer has more than one dir.
850 (and (cdr dired-subdir-alist)
492d2437
RS
851 (dired-goto-subdir up))
852 (progn
853 (dired up)
854 (dired-goto-file dir)))))
84fc2cfa
ER
855
856(defun dired-find-file ()
857 "In dired, visit the file or directory named on this line."
858 (interactive)
c3554e95 859 (find-file (file-name-sans-versions (dired-get-filename) t)))
84fc2cfa
ER
860
861(defun dired-view-file ()
492d2437
RS
862 "In dired, examine a file in view mode, returning to dired when done.
863When file is a directory, show it in this buffer if it is inserted;
864otherwise, display it in another buffer."
84fc2cfa
ER
865 (interactive)
866 (if (file-directory-p (dired-get-filename))
7b2469ae
RS
867 (or (and (cdr dired-subdir-alist)
868 (dired-goto-subdir (dired-get-filename)))
492d2437 869 (dired (dired-get-filename)))
715984d3 870 (view-file (dired-get-filename))))
84fc2cfa
ER
871
872(defun dired-find-file-other-window ()
873 "In dired, visit this file or directory in another window."
874 (interactive)
c3554e95 875 (find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
ab67260b
RS
876
877(defun dired-display-file ()
878 "In dired, display this file or directory in another window."
879 (interactive)
c3554e95
RS
880 (let ((file (file-name-sans-versions (dired-get-filename) t)))
881 (display-buffer (find-file-noselect file))))
492d2437
RS
882\f
883;;; Functions for extracting and manipulating file names in dired buffers.
84fc2cfa
ER
884
885(defun dired-get-filename (&optional localp no-error-if-not-filep)
886 "In dired, return name of file mentioned on this line.
887Value returned normally includes the directory name.
492d2437
RS
888Optional arg LOCALP with value `no-dir' means don't include directory
889 name in result. A value of t means construct name relative to
890 `default-directory', which still may contain slashes if in a subdirectory.
891Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
892 this line, otherwise an error occurs."
893 (let (case-fold-search file p1 p2)
84fc2cfa 894 (save-excursion
492d2437
RS
895 (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
896 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
897 ;; nil if no file on this line, but no-error-if-not-filep is t:
898 (if (setq file (and p1 p2 (buffer-substring p1 p2)))
899 ;; Check if ls quoted the names, and unquote them.
900 ;; Using read to unquote is much faster than substituting
901 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
902 (cond ((string-match "b" dired-actual-switches) ; System V ls
903 ;; This case is about 20% slower than without -b.
904 (setq file
905 (read
906 (concat "\""
907 ;; some ls -b don't escape quotes, argh!
908 ;; This is not needed for GNU ls, though.
909 (or (dired-string-replace-match
910 "\\([^\\]\\)\"" file "\\1\\\\\"")
911 file)
912 "\""))))
913 ;; If you do this, update dired-insert-subdir-validate too
914 ;; ((string-match "Q" dired-actual-switches) ; GNU ls
915 ;; (setq file (read file)))
916 ))
917 (if (eq localp 'no-dir)
918 file
919 (and file (concat (dired-current-directory localp) file)))))
920
921(defun dired-make-absolute (file &optional dir)
922 ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
923 ;; We can't always use expand-file-name as this would get rid of `.'
924 ;; or expand in / instead default-directory if DIR=="".
925 ;; This should be good enough for ange-ftp, but might easily be
926 ;; redefined (for VMS?).
927 ;; It should be reasonably fast, though, as it is called in
928 ;; dired-get-filename.
929 (concat (or dir default-directory) file))
930
931(defun dired-make-relative (file &optional dir no-error)
932 ;;"Convert FILE (an absolute pathname) to a pathname relative to DIR.
933 ;; Else error (unless NO-ERROR is non-nil, then FILE is returned unchanged)
934 ;;DIR defaults to default-directory."
935 ;; DIR must be file-name-as-directory, as with all directory args in
52041219 936 ;; Emacs Lisp code.
492d2437
RS
937 (or dir (setq dir default-directory))
938 (if (string-match (concat "^" (regexp-quote dir)) file)
939 (substring file (match-end 0))
940 (if no-error
941 file
942 (error "%s: not in directory tree growing at %s" file dir))))
943\f
944;;; Functions for finding the file name in a dired buffer line.
945
946;; Move to first char of filename on this line.
947;; Returns position (point) or nil if no filename on this line."
948(defun dired-move-to-filename (&optional raise-error eol)
949 ;; This is the UNIX version.
950 (or eol (setq eol (progn (end-of-line) (point))))
951 (beginning-of-line)
952 (if (re-search-forward
953 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
954 eol t)
955 (progn
956 (skip-chars-forward " ") ; there is one SPC after day of month
957 (skip-chars-forward "^ " eol) ; move after time of day (or year)
958 (skip-chars-forward " " eol) ; there is space before the file name
959 ;; Actually, if the year instead of clock time is displayed,
960 ;; there are (only for some ls programs?) two spaces instead
961 ;; of one before the name.
962 ;; If we could depend on ls inserting exactly one SPC we
963 ;; would not bomb on names _starting_ with SPC.
964 (point))
965 (if raise-error
966 (error "No file on this line")
967 nil)))
968
969(defun dired-move-to-end-of-filename (&optional no-error)
970 ;; Assumes point is at beginning of filename,
971 ;; thus the rwx bit re-search-backward below will succeed in *this*
972 ;; line if at all. So, it should be called only after
973 ;; (dired-move-to-filename t).
974 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
975 ;; This is the UNIX version.
976 (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
977 ;; case-fold-search is nil now, so we can test for capital F:
978 (setq used-F (string-match "F" dired-actual-switches)
979 opoint (point)
980 eol (save-excursion (end-of-line) (point))
981 hidden (and selective-display
982 (save-excursion (search-forward "\r" eol t))))
983 (if hidden
984 nil
985 (save-excursion;; Find out what kind of file this is:
986 ;; Restrict perm bits to be non-blank,
987 ;; otherwise this matches one char to early (looking backward):
988 ;; "l---------" (some systems make symlinks that way)
989 ;; "----------" (plain file with zero perms)
990 (if (re-search-backward
991 "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
992 nil t)
993 (setq file-type (char-after (match-beginning 1))
994 symlink (eq file-type ?l)
995 ;; Only with -F we need to know whether it's an executable
996 executable (and
997 used-F
998 (string-match
999 "[xst]";; execute bit set anywhere?
1000 (concat
1001 (buffer-substring (match-beginning 2)
1002 (match-end 2))
1003 (buffer-substring (match-beginning 3)
1004 (match-end 3))
1005 (buffer-substring (match-beginning 4)
1006 (match-end 4))))))
1007 (or no-error (error "No file on this line"))))
1008 ;; Move point to end of name:
1009 (if symlink
1010 (if (search-forward " ->" eol t)
1011 (progn
1012 (forward-char -3)
1013 (and used-F
1014 dired-ls-F-marks-symlinks
1015 (eq (preceding-char) ?@);; did ls really mark the link?
1016 (forward-char -1))))
1017 (goto-char eol);; else not a symbolic link
1018 ;; ls -lF marks dirs, sockets and executables with exactly one
1019 ;; trailing character. (Executable bits on symlinks ain't mean
1020 ;; a thing, even to ls, but we know it's not a symlink.)
1021 (and used-F
1022 (or (memq file-type '(?d ?s))
1023 executable)
1024 (forward-char -1))))
1025 (or no-error
1026 (not (eq opoint (point)))
1027 (error (if hidden
1028 (substitute-command-keys
1029 "File line is hidden, type \\[dired-hide-subdir] to unhide")
1030 "No file on this line")))
1031 (if (eq opoint (point))
1032 nil
1033 (point))))
1034
1035\f
1036;; Keeping Dired buffers in sync with the filesystem and with each other
1037
1038(defvar dired-buffers nil
1039 ;; Enlarged by dired-advertise
1040 ;; Queried by function dired-buffers-for-dir. When this detects a
1041 ;; killed buffer, it is removed from this list.
1042 "Alist of directories and their associated dired buffers.")
1043
1044(defun dired-buffers-for-dir (dir)
1045;; Return a list of buffers that dired DIR (top level or in-situ subdir).
1046;; The list is in reverse order of buffer creation, most recent last.
1047;; As a side effect, killed dired buffers for DIR are removed from
1048;; dired-buffers.
1049 (setq dir (file-name-as-directory dir))
1050 (let ((alist dired-buffers) result elt)
1051 (while alist
1052 (setq elt (car alist))
1053 (if (dired-in-this-tree dir (car elt))
1054 (let ((buf (cdr elt)))
1055 (if (buffer-name buf)
1056 (if (assoc dir (save-excursion
1057 (set-buffer buf)
1058 dired-subdir-alist))
1059 (setq result (cons buf result)))
1060 ;; else buffer is killed - clean up:
1061 (setq dired-buffers (delq elt dired-buffers)))))
1062 (setq alist (cdr alist)))
1063 result))
1064
1065(defun dired-advertise ()
1066 ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
1067 ;; With wildcards we actually advertise too much.
1068 (if (memq (current-buffer) (dired-buffers-for-dir default-directory))
1069 t ; we have already advertised ourselves
1070 (setq dired-buffers
1071 (cons (cons default-directory (current-buffer))
1072 dired-buffers))))
1073
1074(defun dired-unadvertise (dir)
1075 ;; Remove DIR from the buffer alist in variable dired-buffers.
1076 ;; This has the effect of removing any buffer whose main directory is DIR.
1077 ;; It does not affect buffers in which DIR is a subdir.
1078 ;; Removing is also done as a side-effect in dired-buffer-for-dir.
1079 (setq dired-buffers
1080 (delq (assoc dir dired-buffers) dired-buffers)))
1081\f
1082;; Tree Dired
1083
1084;;; utility functions
1085
1086(defun dired-in-this-tree (file dir)
1087 ;;"Is FILE part of the directory tree starting at DIR?"
1088 (let (case-fold-search)
1089 (string-match (concat "^" (regexp-quote dir)) file)))
1090
1091(defun dired-normalize-subdir (dir)
1092 ;; Prepend default-directory to DIR if relative path name.
1093 ;; dired-get-filename must be able to make a valid filename from a
1094 ;; file and its directory DIR.
1095 (file-name-as-directory
1096 (if (file-name-absolute-p dir)
1097 dir
1098 (expand-file-name dir default-directory))))
1099
1100(defun dired-get-subdir ()
1101 ;;"Return the subdir name on this line, or nil if not on a headerline."
1102 ;; Look up in the alist whether this is a headerline.
1103 (save-excursion
1104 (let ((cur-dir (dired-current-directory)))
1105 (beginning-of-line) ; alist stores b-o-l positions
1106 (and (zerop (- (point)
1107 (dired-get-subdir-min (assoc cur-dir
1108 dired-subdir-alist))))
1109 cur-dir))))
1110
1111;(defun dired-get-subdir-min (elt)
1112; (cdr elt))
1113;; can't use macro, must be redefinable for other alist format in dired-nstd.
1114(fset 'dired-get-subdir-min 'cdr)
1115
1116(defun dired-get-subdir-max (elt)
84fc2cfa 1117 (save-excursion
492d2437
RS
1118 (goto-char (dired-get-subdir-min elt))
1119 (dired-subdir-max)))
1120
1121(defun dired-clear-alist ()
1122 (while dired-subdir-alist
1123 (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
1124 (setq dired-subdir-alist (cdr dired-subdir-alist))))
1125
c9d59fc2
RS
1126(defun dired-subdir-index (dir)
1127 ;; Return an index into alist for use with nth
1128 ;; for the sake of subdir moving commands.
1129 (let (found (index 0) (alist dired-subdir-alist))
1130 (while alist
1131 (if (string= dir (car (car alist)))
1132 (setq alist nil found t)
1133 (setq alist (cdr alist) index (1+ index))))
1134 (if found index nil)))
1135
1136(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
1137 "Go to next subdirectory, regardless of level."
1138 ;; Use 0 arg to go to this directory's header line.
1139 ;; NO-SKIP prevents moving to end of header line, returning whatever
1140 ;; position was found in dired-subdir-alist.
1141 (interactive "p")
1142 (let ((this-dir (dired-current-directory))
1143 pos index)
1144 ;; nth with negative arg does not return nil but the first element
1145 (setq index (- (dired-subdir-index this-dir) arg))
1146 (setq pos (if (>= index 0)
1147 (dired-get-subdir-min (nth index dired-subdir-alist))))
1148 (if pos
1149 (progn
1150 (goto-char pos)
1151 (or no-skip (skip-chars-forward "^\n\r"))
1152 (point))
1153 (if no-error-if-not-found
1154 nil ; return nil if not found
1155 (error "%s directory" (if (> arg 0) "Last" "First"))))))
1156
492d2437
RS
1157(defun dired-build-subdir-alist ()
1158 "Build `dired-subdir-alist' by parsing the buffer.
1159Returns the new value of the alist."
1160 (interactive)
1161 (dired-clear-alist)
1162 (save-excursion
1163 (let ((count 0))
84fc2cfa 1164 (goto-char (point-min))
492d2437
RS
1165 (setq dired-subdir-alist nil)
1166 (while (re-search-forward dired-subdir-regexp nil t)
1167 (setq count (1+ count))
1168 (dired-alist-add-1 (buffer-substring (match-beginning 1)
1169 (match-end 1))
1170 ;; Put subdir boundary between lines:
1171 (save-excursion
1172 (goto-char (match-beginning 0))
1173 (beginning-of-line)
c9d59fc2
RS
1174 (point-marker))))
1175 (if (> count 1)
1176 (message "Buffer includes %d directories" count))
492d2437
RS
1177 ;; We don't need to sort it because it is in buffer order per
1178 ;; constructionem. Return new alist:
1179 dired-subdir-alist)))
1180
1181(defun dired-alist-add-1 (dir new-marker)
1182 ;; Add new DIR at NEW-MARKER. Don't sort.
1183 (setq dired-subdir-alist
1184 (cons (cons (dired-normalize-subdir dir) new-marker)
1185 dired-subdir-alist)))
1186
1187(defun dired-goto-next-nontrivial-file ()
1188 ;; Position point on first nontrivial file after point.
1189 (dired-goto-next-file);; so there is a file to compare with
1190 (if (stringp dired-trivial-filenames)
1191 (while (and (not (eobp))
1192 (string-match dired-trivial-filenames
1193 (file-name-nondirectory
1194 (or (dired-get-filename nil t) ""))))
1195 (forward-line 1)
1196 (dired-move-to-filename))))
1197
1198(defun dired-goto-next-file ()
1199 (let ((max (1- (dired-subdir-max))))
1200 (while (and (not (dired-move-to-filename)) (< (point) max))
1201 (forward-line 1))))
1202
1203(defun dired-goto-file (file)
1204 "Go to file line of FILE in this dired buffer."
1205 ;; Return value of point on success, else nil.
1206 ;; FILE must be an absolute pathname.
1207 ;; Loses if FILE contains control chars like "\007" for which ls
1208 ;; either inserts "?" or "\\007" into the buffer, so we won't find
1209 ;; it in the buffer.
1210 (interactive
1211 (prog1 ; let push-mark display its message
1212 (list (expand-file-name
1213 (read-file-name "Goto file: "
1214 (dired-current-directory))))
1215 (push-mark)))
1216 (setq file (directory-file-name file)) ; does no harm if no directory
1217 (let (found case-fold-search dir)
1218 (setq dir (or (file-name-directory file)
1219 (error "Need absolute pathname for %s" file)))
1220 (save-excursion
1221 ;; The hair here is to get the result of dired-goto-subdir
1222 ;; without really calling it if we don't have any subdirs.
1223 (if (if (string= dir default-directory)
1224 (goto-char (point-min))
7b2469ae 1225 (and (cdr dired-subdir-alist)
492d2437
RS
1226 (dired-goto-subdir dir)))
1227 (let ((base (file-name-nondirectory file))
1228 (boundary (dired-subdir-max)))
1229 (while (and (not found)
1230 ;; filenames are preceded by SPC, this makes
1231 ;; the search faster (e.g. for the filename "-"!).
1232 (search-forward (concat " " base) boundary 'move))
1233 ;; Match could have BASE just as initial substring or
1234 ;; or in permission bits or date or
1235 ;; not be a proper filename at all:
1236 (if (equal base (dired-get-filename 'no-dir t))
1237 ;; Must move to filename since an (actually
1238 ;; correct) match could have been elsewhere on the
1239 ;; ;; line (e.g. "-" would match somewhere in the
1240 ;; permission bits).
1241 (setq found (dired-move-to-filename)))))))
1242 (and found
1243 ;; return value of point (i.e., FOUND):
1244 (goto-char found))))
1245
1246(defun dired-initial-position (dirname)
1247 ;; Where point should go in a new listing of DIRNAME.
1248 ;; Point assumed at beginning of new subdir line.
1249 ;; You may redefine this function as you wish, e.g. like in dired-x.el.
1250 (end-of-line)
1251 (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
1252\f
1253;; These are hooks which make tree dired work.
1254;; They are in this file because other parts of dired need to call them.
1255;; But they don't call the rest of tree dired unless there are subdirs loaded.
1256
1257;; This function is called for each retrieved filename.
1258;; It could stand to be faster, though it's mostly function call
1259;; overhead. Avoiding the function call seems to save about 10% in
1260;; dired-get-filename. Make it a defsubst?
1261(defun dired-current-directory (&optional localp)
1262 "Return the name of the subdirectory to which this line belongs.
1263This returns a string with trailing slash, like `default-directory'.
1264Optional argument means return a file name relative to `default-directory'."
1265 (let ((here (point))
1266 (alist (or dired-subdir-alist
1267 ;; probably because called in a non-dired buffer
1268 (error "No subdir-alist in %s" (current-buffer))))
1269 elt dir)
1270 (while alist
1271 (setq elt (car alist)
1272 dir (car elt)
1273 ;; use `<=' (not `<') as subdir line is part of subdir
1274 alist (if (<= (dired-get-subdir-min elt) here)
1275 nil ; found
1276 (cdr alist))))
1277 (if localp
1278 (dired-make-relative dir default-directory)
1279 dir)))
1280
1281;; Subdirs start at the beginning of their header lines and end just
1282;; before the beginning of the next header line (or end of buffer).
1283
1284(defun dired-subdir-max ()
1285 (save-excursion
7b2469ae 1286 (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
492d2437
RS
1287 (point-max)
1288 (point))))
1289\f
1290;; Deleting files
1291
1292(defun dired-do-flagged-delete ()
1293 "In dired, delete the files flagged for deletion."
1294 (interactive)
1295 (let* ((dired-marker-char dired-del-marker)
1296 (regexp (dired-marker-regexp))
1297 case-fold-search)
1298 (if (save-excursion (goto-char (point-min))
1299 (re-search-forward regexp nil t))
1300 (dired-internal-do-deletions
1301 ;; this can't move point since ARG is nil
1302 (dired-map-over-marks (cons (dired-get-filename) (point))
1303 nil)
1304 nil)
1305 (message "(No deletions requested)"))))
1306
1307(defun dired-do-delete (&optional arg)
1308 "Delete all marked (or next ARG) files."
1309 ;; This is more consistent with the file marking feature than
1310 ;; dired-do-flagged-delete.
1311 (interactive "P")
1312 (dired-internal-do-deletions
1313 ;; this may move point if ARG is an integer
1314 (dired-map-over-marks (cons (dired-get-filename) (point))
1315 arg)
1316 arg))
1317
1318(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
1319
1320(defun dired-internal-do-deletions (l arg)
1321 ;; L is an alist of files to delete, with their buffer positions.
1322 ;; ARG is the prefix arg.
1323 ;; Filenames are absolute (VMS needs this for logical search paths).
1324 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
1325 ;; That way as changes are made in the buffer they do not shift the
1326 ;; lines still to be changed, so the (point) values in L stay valid.
1327 ;; Also, for subdirs in natural order, a subdir's files are deleted
1328 ;; before the subdir itself - the other way around would not work.
1329 (let ((files (mapcar (function car) l))
1330 (count (length l))
1331 (succ 0))
1332 ;; canonicalize file list for pop up
1333 (setq files (nreverse (mapcar (function dired-make-relative) files)))
1334 (if (dired-mark-pop-up
1335 " *Deletions*" 'delete files dired-deletion-confirmer
1336 (format "Delete %s " (dired-mark-prompt arg files)))
84fc2cfa 1337 (save-excursion
492d2437
RS
1338 (let (failures);; files better be in reverse order for this loop!
1339 (while l
1340 (goto-char (cdr (car l)))
1341 (let (buffer-read-only)
1342 (condition-case err
1343 (let ((fn (car (car l))))
1344 ;; This test is equivalent to
1345 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
1346 ;; but more efficient
1347 (if (eq t (car (file-attributes fn)))
ab67260b 1348 (delete-directory fn)
492d2437
RS
1349 (delete-file fn))
1350 ;; if we get here, removing worked
1351 (setq succ (1+ succ))
1352 (message "%s of %s deletions" succ count)
1353 (delete-region (progn (beginning-of-line) (point))
1354 (progn (forward-line 1) (point)))
1355 (dired-clean-up-after-deletion fn))
1356 (error;; catch errors from failed deletions
1357 (dired-log "%s\n" err)
1358 (setq failures (cons (car (car l)) failures)))))
1359 (setq l (cdr l)))
1360 (if (not failures)
1361 (message "%d deletion%s done" count (dired-plural-s count))
1362 (dired-log-summary
1363 (format "%d of %d deletion%s failed"
1364 (length failures) count
1365 (dired-plural-s count))
1366 failures))))
1367 (message "(No deletions performed)")))
1368 (dired-move-to-filename))
1369
1370;; This is a separate function for the sake of dired-x.el.
1371(defun dired-clean-up-after-deletion (fn)
1372 ;; Clean up after a deleted file or directory FN.
7b2469ae
RS
1373 (save-excursion (and (cdr dired-subdir-alist)
1374 (dired-goto-subdir fn)
492d2437
RS
1375 (dired-kill-subdir))))
1376\f
1377;; Confirmation
1378
1379(defun dired-marker-regexp ()
1380 (concat "^" (regexp-quote (char-to-string dired-marker-char))))
1381
1382(defun dired-plural-s (count)
1383 (if (= 1 count) "" "s"))
1384
1385(defun dired-mark-prompt (arg files)
1386 ;; Return a string for use in a prompt, either the current file
1387 ;; name, or the marker and a count of marked files.
1388 (let ((count (length files)))
1389 (if (= count 1)
1390 (car files)
1391 ;; more than 1 file:
1392 (if (integerp arg)
1393 ;; abs(arg) = count
1394 ;; Perhaps this is nicer, but it also takes more screen space:
1395 ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
1396 ;; count)
1397 (format "[next %d files]" arg)
1398 (format "%c [%d files]" dired-marker-char count)))))
1399
1400(defun dired-pop-to-buffer (buf)
1401 ;; Pop up buffer BUF.
1402 ;; If dired-shrink-to-fit is t, make its window fit its contents.
1403 (if (not dired-shrink-to-fit)
1404 (pop-to-buffer (get-buffer-create buf))
1405 ;; let window shrink to fit:
1406 (let ((window (selected-window))
1407 target-lines w2)
1408 (cond ;; if split-window-threshold is enabled, use the largest window
1409 ((and (> (window-height (setq w2 (get-largest-window)))
1410 split-height-threshold)
f98955ea 1411 (= (frame-width) (window-width w2)))
492d2437
RS
1412 (setq window w2))
1413 ;; if the least-recently-used window is big enough, use it
1414 ((and (> (window-height (setq w2 (get-lru-window)))
1415 (* 2 window-min-height))
f98955ea 1416 (= (frame-width) (window-width w2)))
492d2437
RS
1417 (setq window w2)))
1418 (save-excursion
1419 (set-buffer buf)
1420 (goto-char (point-max))
1421 (skip-chars-backward "\n\r\t ")
1422 (setq target-lines (count-lines (point-min) (point))))
1423 (if (<= (window-height window) (* 2 window-min-height))
f98955ea 1424 ;; At this point, every window on the frame is too small to split.
492d2437
RS
1425 (setq w2 (display-buffer buf))
1426 (setq w2 (split-window window
1427 (max window-min-height
1428 (- (window-height window)
1429 (1+ (max window-min-height target-lines)))))))
1430 (set-window-buffer w2 buf)
1431 (if (< (1- (window-height w2)) target-lines)
1432 (progn
1433 (select-window w2)
1434 (enlarge-window (- target-lines (1- (window-height w2))))))
1435 (set-window-start w2 1)
1436 )))
1437
1438(defvar dired-no-confirm nil
1439;; "If non-nil, list of symbols for commands dired should not confirm.
1440;;It can be a sublist of
1441;;
1442;; '(byte-compile chgrp chmod chown compress copy delete hardlink load
1443;; move print shell symlink uncompress)"
1444 )
1445
1446(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
1447 ;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
1448 ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer
1449 ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked
1450 ;;files. Uses function `dired-pop-to-buffer' to do that.
1451 ;; FUNCTION should not manipulate files.
1452 ;; It should only read input (an argument or confirmation).
1453 ;;The window is not shown if there is just one file or
1454 ;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
1455 ;;FILES is the list of marked files."
1456 (or bufname (setq bufname " *Marked Files*"))
1457 (if (or (memq op-symbol dired-no-confirm)
1458 (= (length files) 1))
1459 (apply function args)
1460 (save-excursion
1461 (set-buffer (get-buffer-create bufname))
1462 (erase-buffer)
1463 (dired-format-columns-of-files files))
1464 (save-window-excursion
1465 (dired-pop-to-buffer bufname)
1466 (apply function args))))
1467
1468(defun dired-format-columns-of-files (files)
1469 ;; Files should be in forward order for this loop.
1470 ;; i.e., (car files) = first file in buffer.
1471 ;; Returns the number of lines used.
1472 (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
1473 (width (- (window-width (selected-window)) 2))
1474 (columns (max 1 (/ width maxlen)))
1475 (nfiles (length files))
1476 (rows (+ (/ nfiles columns)
1477 (if (zerop (% nfiles columns)) 0 1)))
1478 (i 0)
1479 (j 0))
1480 (setq files (nconc (copy-sequence files) ; fill up with empty fns
1481 (make-list (- (* columns rows) nfiles) "")))
1482 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
1483 (while (< j rows)
1484 (while (< i columns)
1485 (indent-to (* i maxlen))
1486 (insert (car files))
1487 (setq files (nthcdr rows files)
1488 i (1+ i)))
1489 (insert "\n")
1490 (setq i 0
1491 j (1+ j)
1492 files (cdr files)))
1493 rows))
1494\f
1495;; Commands to mark or flag file(s) at or near current line.
1496
1497(defun dired-repeat-over-lines (arg function)
1498 ;; This version skips non-file lines.
1499 (beginning-of-line)
1500 (while (and (> arg 0) (not (eobp)))
1501 (setq arg (1- arg))
1502 (beginning-of-line)
1503 (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
1504 (save-excursion (funcall function))
1505 (forward-line 1))
1506 (while (and (< arg 0) (not (bobp)))
1507 (setq arg (1+ arg))
1508 (forward-line -1)
1509 (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
1510 (beginning-of-line)
1511 (save-excursion (funcall function))
1512 (dired-move-to-filename))
1513 (dired-move-to-filename))
1514
1515(defun dired-between-files ()
1516 ;; Point must be at beginning of line
1517 ;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
1518 ;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
1519 (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard")
1520 (looking-at dired-subdir-regexp)))
1521
1522(defun dired-next-marked-file (arg &optional wrap opoint)
1523 "Move to the next marked file, wrapping around the end of the buffer."
1524 (interactive "p\np")
1525 (or opoint (setq opoint (point)));; return to where interactively started
1526 (if (if (> arg 0)
1527 (re-search-forward dired-re-mark nil t arg)
1528 (beginning-of-line)
1529 (re-search-backward dired-re-mark nil t (- arg)))
1530 (dired-move-to-filename)
1531 (if (null wrap)
1532 (progn
1533 (goto-char opoint)
1534 (error "No next marked file"))
1535 (message "(Wraparound for next marked file)")
1536 (goto-char (if (> arg 0) (point-min) (point-max)))
1537 (dired-next-marked-file arg nil opoint))))
1538
1539(defun dired-prev-marked-file (arg &optional wrap)
1540 "Move to the previous marked file, wrapping around the end of the buffer."
1541 (interactive "p\np")
1542 (dired-next-marked-file (- arg) wrap))
1543
1544(defun dired-file-marker (file)
1545 ;; Return FILE's marker, or nil if unmarked.
1546 (save-excursion
1547 (and (dired-goto-file file)
1548 (progn
1549 (beginning-of-line)
1550 (if (not (equal ?\040 (following-char)))
1551 (following-char))))))
1552
1553(defun dired-mark-files-in-region (start end)
1554 (let (buffer-read-only)
1555 (if (> start end)
1556 (error "start > end"))
1557 (goto-char start) ; assumed at beginning of line
1558 (while (< (point) end)
1559 ;; Skip subdir line and following garbage like the `total' line:
1560 (while (and (< (point) end) (dired-between-files))
1561 (forward-line 1))
1562 (if (and (not (looking-at dired-re-dot))
1563 (dired-get-filename nil t))
1564 (progn
1565 (delete-char 1)
1566 (insert dired-marker-char)))
1567 (forward-line 1))))
1568
1569(defun dired-mark (arg)
1570 "Mark the current (or next ARG) files.
1571If on a subdir headerline, mark all its files except `.' and `..'.
1572
1573Use \\[dired-unmark-all-files] to remove all marks
1574and \\[dired-unmark] on a subdir to remove the marks in
1575this subdir."
1576 (interactive "P")
7b2469ae 1577 (if (and (cdr dired-subdir-alist) (dired-get-subdir))
492d2437
RS
1578 (save-excursion (dired-mark-subdir-files))
1579 (let (buffer-read-only)
1580 (dired-repeat-over-lines
52041219 1581 (prefix-numeric-value arg)
492d2437
RS
1582 (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
1583
1584(defun dired-unmark (arg)
1585 "Unmark the current (or next ARG) files.
1586If looking at a subdir, unmark all its files except `.' and `..'."
1587 (interactive "P")
1588 (let ((dired-marker-char ?\040))
1589 (dired-mark arg)))
1590
1591(defun dired-flag-file-deletion (arg)
1592 "In dired, flag the current line's file for deletion.
1593With prefix arg, repeat over several lines.
1594
1595If on a subdir headerline, mark all its files except `.' and `..'."
1596 (interactive "P")
1597 (let ((dired-marker-char dired-del-marker))
1598 (dired-mark arg)))
1599
1600(defun dired-unmark-backward (arg)
1601 "In dired, move up lines and remove deletion flag there.
1602Optional prefix ARG says how many lines to unflag; default is one line."
1603 (interactive "p")
1604 (dired-unmark (- arg)))
84fc2cfa 1605\f
492d2437
RS
1606;;; Commands to mark or flag files based on their characteristics or names.
1607
d2cadc4b
RS
1608(defvar dired-regexp-history nil
1609 "History list of regular expressions used in Dired commands.")
1610
1611(defun dired-read-regexp (prompt)
1612 (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
492d2437
RS
1613
1614(defun dired-mark-files-regexp (regexp &optional marker-char)
1615 "Mark all files matching REGEXP for use in later commands.
1616A prefix argument means to unmark them instead.
1617`.' and `..' are never marked.
1618
1619REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
1620object files--just `.o' will mark more than you might think."
1621 (interactive
1622 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
1623 " files (regexp): "))
1624 (if current-prefix-arg ?\040)))
1625 (let ((dired-marker-char (or marker-char dired-marker-char)))
1626 (dired-mark-if
1627 (and (not (looking-at dired-re-dot))
1628 (not (eolp)) ; empty line
1629 (let ((fn (dired-get-filename nil t)))
1630 (and fn (string-match regexp (file-name-nondirectory fn)))))
1631 "matching file")))
1632
1633(defun dired-flag-files-regexp (regexp)
1634 "In dired, flag all files containing the specified REGEXP for deletion.
1635The match is against the non-directory part of the filename. Use `^'
1636 and `$' to anchor matches. Exclude subdirs by hiding them.
1637`.' and `..' are never flagged."
1638 (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
1639 (dired-mark-files-regexp regexp dired-del-marker))
1640
1641(defun dired-mark-symlinks (unflag-p)
1642 "Mark all symbolic links.
1643With prefix argument, unflag all those files."
1644 (interactive "P")
1645 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
1646 (dired-mark-if (looking-at dired-re-sym) "symbolic link")))
1647
1648(defun dired-mark-directories (unflag-p)
1649 "Mark all directory file lines except `.' and `..'.
1650With prefix argument, unflag all those files."
1651 (interactive "P")
1652 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
1653 (dired-mark-if (and (looking-at dired-re-dir)
1654 (not (looking-at dired-re-dot)))
1655 "directory file")))
1656
1657(defun dired-mark-executables (unflag-p)
1658 "Mark all executable files.
1659With prefix argument, unflag all those files."
1660 (interactive "P")
1661 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
1662 (dired-mark-if (looking-at dired-re-exe) "executable file")))
1663
1664;; dired-x.el has a dired-mark-sexp interactive command: mark
1665;; files for which PREDICATE returns non-nil.
1666
1667(defun dired-flag-auto-save-files (&optional unflag-p)
84fc2cfa
ER
1668 "Flag for deletion files whose names suggest they are auto save files.
1669A prefix argument says to unflag those files instead."
1670 (interactive "P")
492d2437
RS
1671 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
1672 (dired-mark-if
1673 (and (not (looking-at dired-re-dir))
1674 (let ((fn (dired-get-filename t t)))
1675 (if fn (auto-save-file-name-p
1676 (file-name-nondirectory fn)))))
1677 "auto save file")))
1678
1679(defun dired-flag-backup-files (&optional unflag-p)
1680 "Flag all backup files (names ending with `~') for deletion.
1681With prefix argument, unflag these files."
1682 (interactive "P")
1683 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
1684 (dired-mark-if
1685 (and (not (looking-at dired-re-dir))
1686 (let ((fn (dired-get-filename t t)))
1687 (if fn (backup-file-name-p fn))))
1688 "backup file")))
1689
6482fcac
RS
1690(defun dired-change-marks (&optional old new)
1691 "Change all OLD marks to NEW marks.
1692OLD and NEW are both characters used to mark files."
1693 (interactive
1694 (let* ((cursor-in-echo-area t)
1695 (old (progn (message "Change (old mark): ") (read-char)))
1696 (new (progn (message "Change %c marks to (new mark): " old)
1697 (read-char))))
1698 (list old new)))
1699 (let ((regexp (format "^%s" (regexp-quote old)))
1700 (buffer-read-only))
1701 (save-excursion
1702 (goto-char (point-min))
1703 (while (re-search-forward regexp nil t)
1704 (beginning-of-line)
1705 (delete-region (point) (1+ (point)))
1706 (insert-char new 1)))))
1707
492d2437
RS
1708(defun dired-unmark-all-files (flag &optional arg)
1709 "Remove a specific mark or any mark from every file.
1710With an arg, queries for each marked file.
1711Type \\[help-command] at that time for help."
1712 (interactive "sRemove mark: (default: all marks) \nP")
1713 (let ((count 0)
1714 (re (if (zerop (length flag)) dired-re-mark
1715 (concat "^" (regexp-quote flag)))))
1716 (save-excursion
1717 (let (buffer-read-only case-fold-search query
1718 (help-form "\
1719Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
1720`!' to unflag all remaining files with no more questions."))
1721 (goto-char (point-min))
1722 (while (re-search-forward re nil t)
1723 (if (or (not arg)
1724 (dired-query 'query "Unmark file `%s'? "
1725 (dired-get-filename t)))
1726 (progn (delete-char -1) (insert " ") (setq count (1+ count))))
1727 (forward-line 1))))
1728 (message "%s" (format "Flags removed: %d %s" count flag) )))
1729\f
492d2437 1730;; Logging failures operating on files, and showing the results.
84fc2cfa 1731
492d2437 1732(defvar dired-log-buffer "*Dired log*")
84fc2cfa 1733
492d2437
RS
1734(defun dired-why ()
1735 "Pop up a buffer with error log output from Dired.
1736A group of errors from a single command ends with a formfeed.
1737Thus, use \\[backward-page] to find the beginning of a group of errors."
1738 (interactive)
1739 (if (get-buffer dired-log-buffer)
1740 (let ((owindow (selected-window))
1741 (window (display-buffer (get-buffer dired-log-buffer))))
1742 (unwind-protect
6482fcac 1743 (progn
492d2437
RS
1744 (select-window window)
1745 (goto-char (point-max))
1746 (recenter -1))
1747 (select-window owindow)))))
1748
1749(defun dired-log (log &rest args)
1750 ;; Log a message or the contents of a buffer.
1751 ;; If LOG is a string and there are more args, it is formatted with
1752 ;; those ARGS. Usually the LOG string ends with a \n.
1753 ;; End each bunch of errors with (dired-log t): this inserts
1754 ;; current time and buffer, and a \f (formfeed).
1755 (let ((obuf (current-buffer)))
1756 (unwind-protect ; want to move point
1757 (progn
1758 (set-buffer (get-buffer-create dired-log-buffer))
1759 (goto-char (point-max))
1760 (let (buffer-read-only)
1761 (cond ((stringp log)
1762 (insert (if args
1763 (apply (function format) log args)
1764 log)))
1765 ((bufferp log)
1766 (insert-buffer log))
1767 ((eq t log)
1768 (insert "\n\t" (current-time-string)
1769 "\tBuffer `" (buffer-name obuf) "'\n\f\n")))))
1770 (set-buffer obuf))))
1771
1772(defun dired-log-summary (string failures)
1773 (message (if failures "%s--type ? for details (%s)"
1774 "%s--type ? for details")
1775 string failures)
1776 ;; Log a summary describing a bunch of errors.
1777 (dired-log (concat "\n" string))
1778 (dired-log t))
1779\f
1780;;; Sorting
1781
1782;; Most ls can only sort by name or by date (with -t), nothing else.
1783;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
1784;; So anything that does not contain these is sort "by name".
1785
1786(defvar dired-ls-sorting-switches "SXU"
1787 "String of `ls' switches (single letters) except `t' that influence sorting.")
1788
1789(defvar dired-sort-by-date-regexp
1790 (concat "^-[^" dired-ls-sorting-switches
1791 "]*t[^" dired-ls-sorting-switches "]*$")
1792 "Regexp recognized by dired to set `by date' mode.")
1793
1794(defvar dired-sort-by-name-regexp
1795 (concat "^-[^t" dired-ls-sorting-switches "]+$")
1796 "Regexp recognized by dired to set `by name' mode.")
1797
1798(defvar dired-sort-mode nil
1799 "Whether Dired sorts by name, date etc. (buffer-local).")
1800;; This is nil outside dired buffers so it can be used in the modeline
1801
1802(defun dired-sort-set-modeline ()
1803 ;; Set modeline display according to dired-actual-switches.
1804 ;; Modeline display of "by name" or "by date" guarantees the user a
1805 ;; match with the corresponding regexps. Non-matching switches are
1806 ;; shown literally.
1807 (setq dired-sort-mode
1808 (let (case-fold-search)
1809 (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
1810 " by name")
1811 ((string-match dired-sort-by-date-regexp dired-actual-switches)
1812 " by date")
1813 (t
1814 (concat " " dired-actual-switches)))))
1815 ;; update mode line:
1816 (set-buffer-modified-p (buffer-modified-p)))
1817
1818(defun dired-sort-toggle-or-edit (&optional arg)
1819 "Toggle between sort by date/name and refresh the dired buffer.
1820With a prefix argument you can edit the current listing switches instead."
84fc2cfa 1821 (interactive "P")
492d2437
RS
1822 (if arg
1823 (dired-sort-other
1824 (read-string "ls switches (must contain -l): " dired-actual-switches))
1825 (dired-sort-toggle)))
1826
1827(defun dired-sort-toggle ()
1828 ;; Toggle between sort by date/name. Reverts the buffer.
1829 (setq dired-actual-switches
1830 (let (case-fold-search)
1831 (concat
1832 "-l"
1833 (dired-replace-in-string (concat "[---lt"
1834 dired-ls-sorting-switches "]")
1835 ""
1836 dired-actual-switches)
1837 (if (string-match (concat "[t" dired-ls-sorting-switches "]")
1838 dired-actual-switches)
1839 ""
1840 "t"))))
1841 (dired-sort-set-modeline)
1842 (revert-buffer))
1843
1844(defun dired-replace-in-string (regexp newtext string)
1845 ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
1846 ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
1847 (let ((result "") (start 0) mb me)
1848 (while (string-match regexp string start)
1849 (setq mb (match-beginning 0)
1850 me (match-end 0)
1851 result (concat result (substring string start mb) newtext)
1852 start me))
1853 (concat result (substring string start))))
1854
1855(defun dired-sort-other (switches &optional no-revert)
1856 ;; Specify new ls SWITCHES for current dired buffer. Values matching
1857 ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the
1858 ;; minor mode accordingly, others appear literally in the mode line.
1859 ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
1860 (setq dired-actual-switches switches)
1861 (dired-sort-set-modeline)
1862 (or no-revert (revert-buffer)))
84fc2cfa 1863\f
492d2437
RS
1864;; To make this file smaller, the less common commands
1865;; go in a separate file. But autoload them here
1866;; to make the separation invisible.
1867
1868(autoload 'dired-diff "dired-aux"
1869 "Compare file at point with file FILE using `diff'.
1870FILE defaults to the file at the mark.
ab67260b 1871The prompted-for file is the first file given to `diff'."
492d2437
RS
1872 t)
1873
1874(autoload 'dired-backup-diff "dired-aux"
1875 "Diff this file with its backup file or vice versa.
1876Uses the latest backup, if there are several numerical backups.
1877If this file is a backup, diff it with its original.
ab67260b 1878The backup file is the first file given to `diff'."
492d2437
RS
1879 t)
1880
2d051399
RS
1881(autoload 'dired-clean-directory "dired-aux"
1882 "Flag numerical backups for deletion.
1883Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
1884Positive prefix arg KEEP overrides `dired-kept-versions';
1885Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
1886
1887To clear the flags on these files, you can use \\[dired-flag-backup-files]
1888with a prefix argument."
1889 t)
1890
492d2437
RS
1891(autoload 'dired-do-chmod "dired-aux"
1892 "Change the mode of the marked (or next ARG) files.
1893This calls chmod, thus symbolic modes like `g+w' are allowed."
1894 t)
1895
1896(autoload 'dired-do-chgrp "dired-aux"
1897 "Change the group of the marked (or next ARG) files."
1898 t)
1899
1900(autoload 'dired-do-chown "dired-aux"
1901 "Change the owner of the marked (or next ARG) files."
1902 t)
1903
1904(autoload 'dired-do-print "dired-aux"
1905 "Print the marked (or next ARG) files.
1906Uses the shell command coming from variables `lpr-command' and
1907`lpr-switches' as default."
1908 t)
1909
1910(autoload 'dired-do-shell-command "dired-aux"
6482fcac
RS
1911 "Run a shell command COMMAND on the marked files.
1912If no files are marked or a specific numeric prefix arg is given,
1913the next ARG files are used. Just \\[universal-argument] means the current file.
1914The prompt mentions the file(s) or the marker, as appropriate.
1915
492d2437 1916If there is output, it goes to a separate buffer.
6482fcac 1917
492d2437
RS
1918Normally the command is run on each file individually.
1919However, if there is a `*' in the command then it is run
1920just once with the entire file list substituted there.
1921
6482fcac
RS
1922No automatic redisplay of dired buffers is attempted, as there's no
1923telling what files the command may have changed. Type
1924\\[dired-do-redisplay] to redisplay the marked files.
492d2437
RS
1925
1926The shell command has the top level directory as working directory, so
1927output files usually are created there instead of in a subdir."
1928 t)
1929
492d2437
RS
1930(autoload 'dired-do-kill-lines "dired-aux"
1931 "Kill all marked lines (not the files).
1932With a prefix arg, kill all lines not marked or flagged."
1933 t)
1934
1935(autoload 'dired-do-compress "dired-aux"
1936 "Compress or uncompress marked (or next ARG) files."
1937 t)
1938
1939(autoload 'dired-do-byte-compile "dired-aux"
1940 "Byte compile marked (or next ARG) Emacs Lisp files."
1941 t)
1942
1943(autoload 'dired-do-load "dired-aux"
1944 "Load the marked (or next ARG) Emacs Lisp files."
1945 t)
1946
1947(autoload 'dired-do-redisplay "dired-aux"
1948 "Redisplay all marked (or next ARG) files.
1949If on a subdir line, redisplay that subdirectory. In that case,
1950a prefix arg lets you edit the `ls' switches used for the new listing."
1951 t)
1952
1953(autoload 'dired-string-replace-match "dired-aux"
1954 "Replace first match of REGEXP in STRING with NEWTEXT.
1955If it does not match, nil is returned instead of the new string.
1956Optional arg LITERAL means to take NEWTEXT literally.
1957Optional arg GLOBAL means to replace all matches."
1958 t)
1959
1960(autoload 'dired-create-directory "dired-aux"
84fc2cfa 1961 "Create a directory called DIRECTORY."
492d2437 1962 t)
84fc2cfa 1963
492d2437
RS
1964(autoload 'dired-do-copy "dired-aux"
1965 "Copy all marked (or next ARG) files, or copy the current file.
1966Thus, a zero prefix argument copies nothing. But it toggles the
1967variable `dired-copy-preserve-time' (which see)."
1968 t)
1969
1970(autoload 'dired-do-symlink "dired-aux"
1971 "Make symbolic links to current file or all marked (or next ARG) files.
1972When operating on just the current file, you specify the new name.
1973When operating on multiple or marked files, you specify a directory
1974and new symbolic links are made in that directory
1975with the same names that the files currently have."
1976 t)
1977
1978(autoload 'dired-do-hardlink "dired-aux"
1979 "Add names (hard links) current file or all marked (or next ARG) files.
1980When operating on just the current file, you specify the new name.
1981When operating on multiple or marked files, you specify a directory
1982and new hard links are made in that directory
1983with the same names that the files currently have."
1984 t)
1985
1986(autoload 'dired-do-rename "dired-aux"
1987 "Rename current file or all marked (or next ARG) files.
1988When renaming just the current file, you specify the new name.
1989When renaming multiple or marked files, you specify a directory."
1990 t)
1991
1992(autoload 'dired-do-rename-regexp "dired-aux"
1993 "Rename marked files containing REGEXP to NEWNAME.
1994As each match is found, the user must type a character saying
1995 what to do with it. For directions, type \\[help-command] at that time.
1996NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
1997REGEXP defaults to the last regexp used.
1998With a zero prefix arg, renaming by regexp affects the complete
1999 pathname - usually only the non-directory part of file names is used
2000 and changed."
2001 t)
2002
2003(autoload 'dired-do-copy-regexp "dired-aux"
2004 "Copy all marked files containing REGEXP to NEWNAME.
2005See function `dired-rename-regexp' for more info."
2006 t)
2007
2008(autoload 'dired-do-hardlink-regexp "dired-aux"
2009 "Hardlink all marked files containing REGEXP to NEWNAME.
2010See function `dired-rename-regexp' for more info."
2011 t)
2012
2013(autoload 'dired-do-symlink-regexp "dired-aux"
2014 "Symlink all marked files containing REGEXP to NEWNAME.
2015See function `dired-rename-regexp' for more info."
2016 t)
2017
2018(autoload 'dired-upcase "dired-aux"
2019 "Rename all marked (or next ARG) files to upper case."
2020 t)
2021
2022(autoload 'dired-downcase "dired-aux"
2023 "Rename all marked (or next ARG) files to lower case."
2024 t)
2025
2026(autoload 'dired-maybe-insert-subdir "dired-aux"
2027 "Insert this subdirectory into the same dired buffer.
2028If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
2029 else inserts it at its natural place (as `ls -lR' would have done).
2030With a prefix arg, you may edit the ls switches used for this listing.
2031 You can add `R' to the switches to expand the whole tree starting at
2032 this subdirectory.
2033This function takes some pains to conform to `ls -lR' output."
2034 t)
2035
2036(autoload 'dired-next-subdir "dired-aux"
2037 "Go to next subdirectory, regardless of level."
2038 t)
2039
2040(autoload 'dired-prev-subdir "dired-aux"
2041 "Go to previous subdirectory, regardless of level.
2042When called interactively and not on a subdir line, go to this subdir's line."
2043 t)
2044
2045(autoload 'dired-goto-subdir "dired-aux"
2046 "Go to end of header line of DIR in this dired buffer.
2047Return value of point on success, otherwise return nil.
2048The next char is either \\n, or \\r if DIR is hidden."
2049 t)
2050
2051(autoload 'dired-mark-subdir-files "dired-aux"
2052 "Mark all files except `.' and `..'."
2053 t)
2054
2055(autoload 'dired-kill-subdir "dired-aux"
2056 "Remove all lines of current subdirectory.
2057Lower levels are unaffected."
2058 t)
2059
2060(autoload 'dired-tree-up "dired-aux"
2061 "Go up ARG levels in the dired tree."
2062 t)
2063
2064(autoload 'dired-tree-down "dired-aux"
2065 "Go down in the dired tree."
2066 t)
2067
2068(autoload 'dired-hide-subdir "dired-aux"
2069 "Hide or unhide the current subdirectory and move to next directory.
2070Optional prefix arg is a repeat factor.
2071Use \\[dired-hide-all] to (un)hide all directories."
2072 t)
2073
2074(autoload 'dired-hide-all "dired-aux"
2075 "Hide all subdirectories, leaving only their header lines.
2076If there is already something hidden, make everything visible again.
2077Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
2078 t)
84fc2cfa 2079\f
492d2437
RS
2080(if (eq system-type 'vax-vms)
2081 (load "dired-vms"))
84fc2cfa 2082
492d2437 2083(run-hooks 'dired-load-hook) ; for your customizations
84fc2cfa 2084
52041219
RS
2085(provide 'dired)
2086
2087;;; dired.el ends here