comparison lisp/efs/dired.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents
children 4be1180a9e89
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ; -*- Emacs-Lisp -*-
2 ;; DIRED commands for Emacs.
3 ;; Copyright (C) 1985, 1986, 1991 Free Software Foundation, Inc.
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 ;;
6 ;; File: dired.el
7 ;; RCS:
8 ;; Dired Version: $Revision: 1.2 $
9 ;; Description: The DIRectory EDitor is for manipulating, and running
10 ;; commands on files in a directory.
11 ;; Authors: FSF,
12 ;; Sebastian Kremer <sk@thp.uni-koeln.de>,
13 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
14 ;; Cast of thousands...
15 ;;
16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17
18 ;; This program is free software; you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation; either version 1, or (at your option)
21 ;; any later version.
22
23 ;; This program is distributed in the hope that it will be useful,
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 ;; GNU General Public License for more details.
27
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs; see the file COPYING. If not, write to
30 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
31
32 ;; Rewritten in 1990/1991 to add tree features, file marking and
33 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
34 ;; 7-1993: Added special features for efs interaction and upgraded to Emacs 19.
35 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
36
37 ;;; Dired Version
38
39 (defconst dired-version (substring "$Revision: 1.2 $" 11 -2)
40 "The revision number of Tree Dired (as a string).
41
42 Don't forget to mention this when reporting bugs to:
43
44 efs-bugs@cuckoo.hpl.hp.com")
45
46 ;; Global key bindings:
47 ;; --------------------
48 ;;
49 ;; By convention, dired uses the following global key-bindings.
50 ;; These may or may not already be set up in your local emacs. If not
51 ;; then you will need to add them to your .emacs file, or the system
52 ;; default.el file. We don't set them automatically here, as users may
53 ;; have individual preferences.
54 ;;
55 ;; (define-key ctl-x-map "d" 'dired)
56 ;; (define-key ctl-x-4-map "d" 'dired-other-window)
57 ;; (define-key ctl-x-map "\C-j" 'dired-jump-back)
58 ;; (define-key ctl-x-4-map "\C-j" 'dired-jump-back-other-window)
59 ;;
60 ;; For V19 emacs only. (Make sure that the ctl-x-5-map exists.)
61 ;; (define-key ctl-x-5-map "d" 'dired-other-frame)
62 ;; (define-key Ctl-x-5-map "\C-j" 'dired-jump-back-other-frame)
63
64
65 ;;; Grok the current emacs version
66 ;;
67 ;; Hopefully these two variables provide us with enough version sensitivity.
68
69 ;; Make sure that we have a frame-width function
70 (or (fboundp 'frame-width) (fset 'frame-width 'screen-width))
71
72 ;;; Requirements and provisions
73
74 (provide 'dired)
75 (require 'backquote) ; For macros.
76
77 ;; Compatibility requirements for the file-name-handler-alist.
78 (let ((lucid-p (string-match "Lucid" emacs-version))
79 ver subver)
80 (or (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
81 (error "dired does not work with emacs version %s" emacs-version))
82 (setq ver (string-to-int (substring emacs-version (match-beginning 1)
83 (match-end 1)))
84 subver (string-to-int (substring emacs-version (match-beginning 2)
85 (match-end 2))))
86 (cond
87 ((= ver 18)
88 (require 'emacs-19)
89 (require 'fn-handler))
90 ((and (= ver 19) (if lucid-p (< subver 10) (< subver 23)))
91 (require 'fn-handler))
92 ((< ver 18)
93 (error "dired does not work with emacs version %s" emacs-version))))
94
95 ;; Load default-dir last, because we want its interactive specs.
96 (require 'default-dir)
97
98
99 ;;;;----------------------------------------------------------------
100 ;;;; Customizable variables
101 ;;;;----------------------------------------------------------------
102 ;;
103 ;; The funny comments are for autoload.el, to automagically update
104 ;; loaddefs.
105
106 ;;; Variables for compressing files.
107
108 ;;;###autoload
109 (defvar dired-compression-method 'compress
110 "*Type of compression program to use.
111 Give as a symbol.
112 Currently-recognized methods are: gzip pack compact compress.
113 To change this variable use \\[dired-do-compress] with a zero prefix.")
114
115 ;;;###autoload
116 (defvar dired-compression-method-alist
117 '((gzip ".gz" ("gzip") ("gzip" "-d") "-f")
118 ;; Put compress before pack, so that it wins out if we are using
119 ;; efs to work on a case insensitive OS. The -f flag does
120 ;; two things in compress. No harm in giving it twice.
121 (compress ".Z" ("compress" "-f") ("compress" "-d") "-f")
122 ;; pack support may not work well. pack is too chatty and there is no way
123 ;; to force overwrites.
124 (pack ".z" ("pack" "-f") ("unpack"))
125 (compact ".C" ("compact") ("uncompact")))
126
127 "*Association list of compression method descriptions.
128 Each element of the table should be a list of the form
129
130 \(compress-type extension (compress-args) (decompress-args) force-flag\)
131
132 where
133 `compress-type' is a unique symbol in the alist to which
134 `dired-compression-method' can be set;
135 `extension' is the file extension (as a string) used by files compressed
136 by this method;
137 `compress-args' is a list of the path of the compression program and
138 flags to pass as separate arguments;
139 `decompress-args' is a list of the path of the decompression
140 program and flags to pass as separate arguments.
141 `force-flag' is the switch to pass to the command to force overwriting
142 of existing files.
143
144 For example:
145
146 \(setq dired-compresssion-method-alist
147 \(cons '\(frobnicate \".frob\" \(\"frob\"\) \(\"frob\" \"-d\"\) \"-f\"\)
148 dired-compression-method-alist\)\)
149 => \(\(frobnicate \".frob\" \(\"frob\"\) \(\"frob\" \"-d\"\)\)
150 \(gzip \".gz\" \(\"gzip\"\) \(\"gunzip\"\)\)
151 ...\)
152
153 See also: dired-compression-method <V>")
154
155 ;;; Variables for the ls program.
156
157 ;;;###autoload
158 (defvar dired-ls-program "ls"
159 "*Absolute or relative name of the ls program used by dired.")
160
161 ;;;###autoload
162 (defvar dired-listing-switches "-al"
163 "*Switches passed to ls for dired. MUST contain the `l' option.
164 Can contain even `F', `b', `i' and `s'.")
165
166 (defvar dired-ls-F-marks-symlinks
167 (memq system-type '(aix-v3 hpux silicon-graphics-unix))
168 ;; Both SunOS and Ultrix have system-type berkeley-unix. But
169 ;; SunOS doesn't mark symlinks, but Ultrix does. Therefore,
170 ;; can't grok this case.
171 "*Informs dired about how ls -lF marks symbolic links.
172 Set this to t if `dired-ls-program' with -lF marks the name of the symbolic
173 link itself with a trailing @.
174
175 For example: If foo is a link pointing to bar, and \"ls -F bar\" gives
176
177 ... bar -> foo
178
179 set this variable to nil. If it gives
180
181 ... bar@ -> foo
182
183 set this variable to t.
184
185 Dired checks if there is really a @ appended. Thus, if you have a
186 marking ls program on one host and a non-marking on another host, and
187 don't care about symbolic links which really end in a @, you can
188 always set this variable to t.
189
190 If you use efs, it will make this variable buffer-local, and control
191 it according to its assessment of how the remote host marks symbolic
192 links.")
193
194 (defvar dired-show-ls-switches nil
195 "*If non-nil dired will show the dired ls switches on the modeline.
196 If nil, it will indicate how the files are sorted by either \"by name\" or
197 \"by date\". If it is unable to recognize the sorting defined by the switches,
198 then the switches will be shown explicitly on the modeline, regardless of the
199 setting of this variable.")
200
201 ;;; Variables for other unix utility programs.
202
203 ;; For most program names, don't use absolute paths so that dired
204 ;; uses the user's value of the environment variable PATH. chown is
205 ;; an exception as it is not always in the PATH.
206
207 ;;;###autoload
208 (defvar dired-chown-program
209 (if (memq system-type '(hpux dgux usg-unix-v)) "chown" "/etc/chown")
210 "*Name of chown command (usully `chown' or `/etc/chown').")
211
212 ;;;###autoload
213 (defvar dired-gnutar-program nil
214 "*If non-nil, name of the GNU tar executable (e.g. \"tar\" or \"gnutar\").
215 GNU tar's `z' switch is used for compressed tar files.
216 If you don't have GNU tar, set this to nil: a pipe using `zcat' is then used.")
217
218 ;;;###autoload
219 (defvar dired-unshar-program nil
220 "*Set to the name of the unshar program, if you have it.")
221
222 ;;; Markers
223
224 (defvar dired-keep-marker-rename t
225 ;; Use t as default so that moved files `take their markers with them'
226 "*Controls marking of renamed files.
227 If t, files keep their previous marks when they are renamed.
228 If a character, renamed files (whether previously marked or not)
229 are afterward marked with that character.")
230
231 (defvar dired-keep-marker-compress t
232 "*Controls marking of compressed or uncompressed files.
233 If t, files keep their previous marks when they are compressed.
234 If a character, compressed or uncompressed files (whether previously
235 marked or not) are afterward marked with that character.")
236
237 (defvar dired-keep-marker-uucode ?U
238 "*Controls marking of uuencoded or uudecoded files.
239 If t, files keep their previous marks when they are uuencoded.
240 If a character, uuencoded or uudecoded files (whether previously
241 marked or not) are afterward marked with that character.")
242
243 (defvar dired-keep-marker-copy ?C
244 "*Controls marking of copied files.
245 If t, copied files are marked if and as the corresponding original files were.
246 If a character, copied files are unconditionally marked with that character.")
247
248 (defvar dired-keep-marker-hardlink ?H
249 "*Controls marking of newly made hard links.
250 If t, they are marked if and as the files linked to were marked.
251 If a character, new links are unconditionally marked with that character.")
252
253 (defvar dired-keep-marker-symlink ?S
254 "*Controls marking of newly made symbolic links.
255 If t, they are marked if and as the files linked to were marked.
256 If a character, new links are unconditionally marked with that character.")
257
258 (defvar dired-keep-marker-kill ?K
259 "*When killed file lines are redisplayed, they will have this marker.
260 Setting this to nil means that they will not have any marker.")
261
262 (defvar dired-failed-marker-shell ?!
263 "*If non-nil, a character with which to mark files of failed shell commands.
264 Applies to the command `dired-do-shell-command'. Files for which the shell
265 command has a nonzero exit status will be marked with this character")
266
267 ;;; Behavioral Variables
268
269 ;;;###autoload
270 (defvar dired-local-variables-file ".dired"
271 "*If non-nil, filename for local variables for Dired.
272 If Dired finds a file with that name in the current directory, it will
273 temporarily insert it into the dired buffer and run `hack-local-variables'.
274
275 Type \\[info] and `g' `(emacs)File Variables' `RET' for more info on
276 local variables.")
277
278 ;; Usually defined in files.el. Define here anyway, to be safe.
279 ;;;###autoload
280 (defvar dired-kept-versions 2
281 "*When cleaning directory, number of versions to keep.")
282
283 ;;;###autoload
284 (defvar dired-find-subdir nil
285 "*Determines whether dired tries to lookup a subdir in existing buffers.
286 If non-nil, dired does not make a new buffer for a directory if it can be
287 found (perhaps as subdir) in some existing dired buffer. If there are several
288 dired buffers for a directory, then the most recently used one is chosen.
289
290 Dired avoids switching to the current buffer, so that if you have
291 a normal and a wildcard buffer for the same directory, C-x d RET will
292 toggle between those two.")
293
294 ;;;###autoload
295 (defvar dired-use-file-transformers t
296 "*Determines whether dired uses file transformers.
297 If non-nil `dired-do-shell-command' will apply file transformers to file names.
298 See \\[describe-function] for dired-do-shell-command for more information.")
299
300 ;;;###autoload
301 (defvar dired-dwim-target nil
302 "*If non-nil, dired tries to guess a default target directory.
303 This means that if there is a dired buffer displayed in the next window,
304 use its current subdir, instead of the current subdir of this dired buffer.
305 The target is put in the prompt for file copy, rename, etc.")
306
307 ;;;###autoload
308 (defvar dired-copy-preserve-time nil
309 "*If non-nil, Dired preserves the last-modified time in a file copy.
310 \(This works on only some systems.)\\<dired-mode-map>
311 Use `\\[dired-do-copy]' with a zero prefix argument to toggle its value.")
312
313 ;;;###autoload
314 (defvar dired-no-confirm nil
315 "*If non-nil, a list of symbols for commands dired should not confirm.
316 It can be a sublist of
317
318 '(byte-compile chgrp chmod chown compress copy delete hardlink load
319 move print shell symlink uncompress recursive-delete kill-file-buffer
320 kill-dired-buffer patch create-top-dir revert-subdirs)
321
322 The meanings of most of the symbols are obvious. A few exceptions:
323
324 'compress applies to compression or decompression by any of the
325 compression program in `dired-compression-method-alist'.
326
327 'kill-dired-buffer applies to offering to kill dired buffers for
328 directories which have been deleted.
329
330 'kill-file-buffer applies to offering to kill buffers visiting files
331 which have been deleted.
332
333 'recursive-delete applies to recursively deleting non-empty
334 directories, and all of their contents.
335
336 'create-top-dir applies to `dired-up-directory' creating a new top level
337 directory for the dired buffer.
338
339 'revert-subdirs applies to re-reading subdirectories which have
340 been modified on disk.
341
342 Note that this list also applies to remote files accessed with efs
343 or ange-ftp.")
344
345 ;;;###autoload
346 (defvar dired-backup-if-overwrite nil
347 "*Non-nil if Dired should ask about making backups before overwriting files.
348 Special value 'always suppresses confirmation.")
349
350 ;;;###autoload
351 (defvar dired-omit-files nil
352 "*If non-nil un-interesting files will be omitted from this dired buffer.
353 Use \\[dired-omit-toggle] to see these files. (buffer local)")
354 (make-variable-buffer-local 'dired-omit-files)
355
356 ;;;###autoload
357 (defvar dired-mail-reader 'rmail
358 "*Mail reader used by dired for dired-read-mail \(\\[dired-read-mail]\).
359 The symbols 'rmail and 'vm are the only two allowed values.")
360
361 (defvar dired-verify-modtimes t
362 "*If non-nil dired will revert dired buffers for modified subdirectories.
363 See also dired-no-confirm <V>.")
364
365 ;;; File name regular expressions and extensions.
366
367 (defvar dired-trivial-filenames "^\\.\\.?$\\|^#"
368 "*Regexp of files to skip when finding first file of a directory listing.
369 A value of nil means move to the subdir line.
370 A value of t means move to first file.")
371
372 (defvar dired-cleanup-alist
373 (list
374 '("tex" ".toc" ".log" ".aux" ".dvi")
375 '("latex" ".toc" ".log" ".aux" ".idx" ".lof" ".lot" ".glo" ".dvi")
376 '("bibtex" ".blg" ".bbl")
377 '("texinfo" ".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs"
378 ".tp" ".tps" ".vr" ".vrs")
379 '("patch" ".rej" ".orig")
380 '("backups" "~")
381 (cons "completion-ignored-extensions" completion-ignored-extensions))
382 "*Alist of extensions for temporary files created by various programs.
383 Used by `dired-cleanup'.")
384
385 (defvar dired-omit-extensions
386 (let ((alist dired-cleanup-alist)
387 x result)
388 (while alist
389 (setq x (cdr (car alist))
390 alist (cdr alist))
391 (while x
392 (or (member (car x) result)
393 (setq result (cons (car x) result)))
394 (setq x (cdr x))))
395 result)
396 "*List of extensions for file names that will be omitted (buffer-local).
397 This only has effect when the subdirectory is in omission mode.
398 To make omission mode the default, set `dired-omit-files' to t.
399 See also `dired-omit-extensions'.")
400 (make-variable-buffer-local 'dired-omit-extensions)
401
402 (defvar dired-omit-regexps '("^#" "^\\.")
403 "*File names matching these regexp may be omitted (buffer-local).
404 This only has effect when the subdirectory is in omission mode.
405 To make omission mode the default, set `dired-omit-files' to t.
406 This only has effect when `dired-omit-files-p' is t.
407 See also `dired-omit-extensions'.")
408 (make-variable-buffer-local 'dired-omit-files-regexp)
409
410 (defvar dired-filename-re-ext "\\..+$" ; start from the first dot. last dot?
411 "*Defines what is the extension of a file name.
412 \(match-beginning 0\) for this regexp in the file name without directory will
413 be taken to be the start of the extension.")
414
415 ;;; Hook variables
416
417 (defvar dired-load-hook nil
418 "Run after loading dired.
419 You can customize key bindings or load extensions with this.")
420
421 (defvar dired-grep-load-hook nil
422 "Run after loading dired-grep.")
423
424 (defvar dired-mode-hook nil
425 "Run at the very end of dired-mode.")
426
427 (defvar dired-before-readin-hook nil
428 "Hook run before a dired buffer is newly read in, created,or reverted.")
429
430 (defvar dired-after-readin-hook nil
431 "Hook run after each listing of a file or directory.
432 The buffer is narrowed to the new listing.")
433
434 (defvar dired-setup-keys-hook nil
435 "Hook run when dired sets up its keymap.
436 This happens the first time that `dired-mode' is called, and runs after
437 `dired-mode-hook'. This hook can be used to make alterations to the
438 dired keymap.")
439
440 ;;; Internal variables
441 ;;
442 ;; If you set these, know what you are doing.
443
444 ;;; Marker chars.
445
446 (defvar dired-marker-char ?* ; the answer is 42
447 ; life the universe and everything
448 ;; so that you can write things like
449 ;; (let ((dired-marker-char ?X))
450 ;; ;; great code using X markers ...
451 ;; )
452 ;; For example, commands operating on two sets of files, A and B.
453 ;; Or marking files with digits 0-9. This could implicate
454 ;; concentric sets or an order for the marked files.
455 ;; The code depends on dynamic scoping on the marker char.
456 "In dired, character used to mark files for later commands.")
457 (make-variable-buffer-local 'dired-marker-char)
458
459 (defconst dired-default-marker dired-marker-char)
460 ;; Stores the default value of dired-marker-char when dynamic markers
461 ;; are being used.
462
463 (defvar dired-del-marker ?D
464 "Character used to flag files for deletion.")
465
466 ;; \017=^O for Omit - other packages can chose other control characters.
467 (defvar dired-omit-marker-char ?\017)
468 ;; Marker used for omitted files. Shouldn't be used by anything else.
469
470 (defvar dired-kill-marker-char ?\C-k)
471 ;; Marker used by dired-do-kill. Shouldn't be used by anything else.
472
473 ;;; State variables
474
475 (defvar dired-mode-line-modified "-%s%s%s-"
476 "*Format string to show the modification status of the buffer.")
477
478 (defvar dired-del-flags-number 0)
479 (make-variable-buffer-local 'dired-del-flags-number)
480 (defvar dired-marks-number 0)
481 (make-variable-buffer-local 'dired-marks-number)
482 (defvar dired-other-marks-number 0)
483 (make-variable-buffer-local 'dired-other-marks-number)
484
485 (defvar dired-marked-files nil
486 "List of filenames from last `dired-copy-filename-as-kill' call.")
487
488 (defvar dired-directory nil
489 "The directory name or shell wildcard that was used as argument to `ls'.
490 Local to each dired buffer. May be a list, in which case the car is the
491 directory name and the cdr is the actual files to list.")
492 (make-variable-buffer-local 'dired-directory)
493
494 (defvar dired-internal-switches nil
495 "The actual (buffer-local) value of `dired-listing-switches'.
496 The switches are represented as a list of characters.")
497 (make-variable-buffer-local 'dired-internal-switches)
498
499 (defvar dired-subdir-alist nil
500 "Association list of subdirectories and their buffer positions.
501 Each subdirectory has an element: (DIRNAME . STARTMARKER).
502 The order of elements is the reverse of the order in the buffer.")
503 (make-variable-buffer-local 'dired-subdir-alist)
504
505 (defvar dired-curr-subdir-min 0)
506 ;; Cache for modeline tracking of the cursor
507 (make-variable-buffer-local 'dired-curr-subdir-min)
508
509 (defvar dired-curr-subdir-max 0)
510 ;; Cache for modeline tracking of the cursor
511 (make-variable-buffer-local 'dired-curr-subdir-max)
512
513 (defvar dired-subdir-omit nil)
514 ;; Controls whether the modeline shows Omit.
515 (make-variable-buffer-local 'dired-subdir-omit)
516
517 (defvar dired-in-query nil)
518 ;; let-bound to t when dired is in the process of querying the user.
519 ;; This is to keep asynch messaging from clobbering the query prompt.
520
521 (defvar dired-overwrite-confirmed nil)
522 ;; Fluid variable used to remember if a bunch of overwrites have been
523 ;; confirmed.
524
525 (defvar dired-overwrite-backup-query nil)
526 ;; Fluid var used to remember if backups have been requested for overwrites.
527
528 (defvar dired-file-creator-query nil)
529 ;; Fluid var to remember responses to file-creator queries.
530
531 (defvar dired-omit-silent nil)
532 ;; This is sometimes let-bound to t if messages would be annoying,
533 ;; e.g., in dired-awrh.el. Binding to 0, only suppresses
534 ;; \"(Nothing to omit)\" message.
535
536 (defvar dired-buffers nil
537 ;; Enlarged by dired-advertise
538 ;; Queried by function dired-buffers-for-dir. When this detects a
539 ;; killed buffer, it is removed from this list.
540 "Alist of directories and their associated dired buffers.")
541
542 (defvar dired-sort-mode nil
543 "Whether Dired sorts by name, date, etc.
544 \(buffer-local\)")
545 ;; This is nil outside dired buffers so it can be used in the modeline
546 (make-variable-buffer-local 'dired-sort-mode)
547
548 (defvar dired-marker-stack nil
549 "List of previously used dired marker characters.")
550 (make-variable-buffer-local 'dired-marker-stack)
551
552 (defvar dired-marker-stack-pointer 0)
553 ;; Points to the current marker in the stack
554 (make-variable-buffer-local 'dired-marker-stack-pointer)
555
556 (defvar dired-marker-stack-cursor ?\ ; space
557 "Character to use as a cursor in the dired marker stack.")
558
559 (defconst dired-marker-string ""
560 "String version of `dired-marker-stack'.")
561 (make-variable-buffer-local 'dired-marker-string)
562
563 (defvar dired-modeline-tracking-cmds nil)
564 ;; List of commands after which the modeline gets updated.
565
566 ;;; Config. variables not usually considered fair game for the user.
567
568 (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
569
570 (defvar dired-log-buffer "*Dired log*")
571 ;; Name of buffer used to log dired messages and errors.
572
573 ;;; Assoc. lists
574
575 ;; For pop ups and user input for file marking
576 (defvar dired-query-alist
577 '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
578 (?n . n) (?\177 . n) ; `n' or DEL skips once
579 (?! . yes) ; `!' accepts rest
580 (?q. no) (?\e . no) ; `q' or ESC skips rest
581 ;; None of these keys quit - use C-g for that.
582 ))
583
584 (defvar dired-sort-type-alist
585 ;; alist of sort flags, and the sort type, as a symbol.
586 ;; Don't put ?r in here. It's handled separately.
587 '((?t . date) (?S . size) (?U . unsort) (?X . ext)))
588
589 ;;; Internal regexps for examining ls listings.
590 ;;
591 ;; Many of these regexps must be tested at beginning-of-line, but are also
592 ;; used to search for next matches, so neither omitting "^" nor
593 ;; replacing "^" by "\n" (to make it slightly faster) will work.
594
595 (defvar dired-re-inode-size "[ \t0-9]*")
596 ;; Regexp for optional initial inode and file size.
597 ;; Must match output produced by ls' -i and -s flags.
598
599 (defvar dired-re-mark "^[^ \n\r]")
600 ;; Regexp matching a marked line.
601 ;; Important: the match ends just after the marker.
602
603 (defvar dired-re-maybe-mark "^. ")
604
605 (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
606 ;; Matches directory lines
607
608 (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
609 ;; Matches symlink lines
610
611 (defvar dired-re-exe;; match ls permission string of an executable file
612 (mapconcat (function
613 (lambda (x)
614 (concat dired-re-maybe-mark dired-re-inode-size x)))
615 '("-[-r][-w][xs][-r][-w].[-r][-w]."
616 "-[-r][-w].[-r][-w][xs][-r][-w]."
617 "-[-r][-w].[-r][-w].[-r][-w][xst]")
618 "\\|"))
619
620 (defvar dired-re-dot "^.* \\.\\.?/?$") ; with -F, might end in `/'
621 ;; . and .. files
622
623 (defvar dired-re-month-and-time
624 (concat
625 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct\\|Nov\\|"
626 ; June and July are for HP-UX 9.0
627 "Dec\\) [ 0-3][0-9]\\("
628 " [012][0-9]:[0-6][0-9] \\|" ; time
629 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo,
630 ; HP-UX, A/UX
631 " [12][90][0-9][0-9] \\)" ; year on AIX
632 ))
633 ;; This regexp MUST match all the way to first character of the filename.
634 ;; You can loosen it to taste, but then you might bomb on filenames starting
635 ;; with a space. This will have to be modified for non-english month names.
636
637 (defvar dired-subdir-regexp
638 "\\([\n\r]\n\\|\\`\\). \\([^\n\r]+\\)\\(:\\)\\(\\.\\.\\.\r\\|[\n\r]\\)")
639 ;; Regexp matching a maybe hidden subdirectory line in ls -lR output.
640 ;; Subexpression 2 is the subdirectory proper, no trailing colon.
641 ;; Subexpression 3 must end right before the \n or \r at the end of
642 ;; the subdir heading. Matches headings after indentation has been done.
643
644 (defvar dired-unhandle-add-files nil)
645 ;; List of files that the dired handler function need not add to dired buffers.
646 ;; This is because they have already been added, most likely in
647 ;; dired-create-files. This is because dired-create-files add files with
648 ;; special markers.
649
650 ;;; history variables
651
652 (defvar dired-regexp-history nil
653 "History list of regular expressions used in Dired commands.")
654
655 (defvar dired-chmod-history nil
656 "History of arguments to chmod in dired.")
657
658 (defvar dired-chown-history nil
659 "History of arguments to chown in dired.")
660
661 (defvar dired-chgrp-history nil
662 "History of arguments to chgrp in dired.")
663
664 (defvar dired-cleanup-history nil
665 "History of arguments to dired-cleanup.")
666
667 (defvar dired-goto-file-history nil)
668 ;; History for dired-goto-file and dired-goto-subdir
669 (put 'dired-goto-file-history 'cursor-end t) ; for gmhist
670
671 (defvar dired-history nil)
672 ;; Catch-all history variable for dired file ops without
673 ;; their own history.
674
675 (defvar dired-op-history-alist
676 ;; alist of dired file operations and history symbols
677 '((chgrp . dired-chgrp-history) (chown . dired-chown-history)
678 (chmod . dired-chmod-history) ))
679
680 ;;; Tell the byte-compiler that we know what we're doing.
681 ;;; Do we?
682
683 (defvar file-name-handler-alist)
684 (defvar inhibit-file-name-operation)
685 (defvar inhibit-file-name-handlers)
686 (defvar efs-dired-host-type)
687
688
689 ;;;;------------------------------------------------------------------
690 ;;;; Utilities
691 ;;;;------------------------------------------------------------------
692
693 ;;; Macros
694 ;;
695 ;; Macros must be defined before they are used - for the byte compiler.
696
697 (defmacro dired-get-subdir-min (elt)
698 ;; Returns the value of the subdir minumum for subdir with entry ELT in
699 ;; dired-subdir-alist.
700 (list 'nth 1 elt))
701
702 (defmacro dired-save-excursion (&rest body)
703 ;; Saves excursions of the point (not buffer) in dired buffers.
704 ;; It tries to be robust against deletion of the region about the point.
705 ;; Note that this assumes only dired-style deletions.
706 (let ((temp-bolm (make-symbol "bolm"))
707 (temp-fnlp (make-symbol "fnlp"))
708 (temp-offset-bol (make-symbol "offset-bol")))
709 (` (let (((, temp-bolm) (make-marker))
710 (, temp-fnlp) (, temp-offset-bol))
711 (let ((bol (save-excursion (skip-chars-backward "^\n\r") (point))))
712 (set-marker (, temp-bolm) bol)
713 (setq (, temp-offset-bol) (- (point) bol)
714 (, temp-fnlp) (memq (char-after bol) '(?\n\ ?\r))))
715 (unwind-protect
716 (progn
717 (,@ body))
718 ;; Use the marker to try to find the right line, then move to
719 ;; the proper column.
720 (goto-char (, temp-bolm))
721 (and (not (, temp-fnlp))
722 (not (eq (following-char) 0)) (memq (following-char) '(?\n ?\r))
723 ;; The line containing the point got deleted. Note that this
724 ;; logic only works if we don't delete null lines, but we never
725 ;; do.
726 (forward-line 1)) ; don't move into a hidden line.
727 (skip-chars-forward "^\n\r" (+ (point) (, temp-offset-bol))))))))
728
729 (put 'dired-save-excursion 'lisp-indent-hook 0)
730
731 (defun dired-substitute-marker (pos old new)
732 ;; Change marker, re-fontify
733 (subst-char-in-region pos (1+ pos) old new)
734 (dired-move-to-filename))
735
736 (defmacro dired-mark-if (predicate msg)
737 ;; Mark all files for which CONDITION evals to non-nil.
738 ;; CONDITION is evaluated on each line, with point at beginning of line.
739 ;; MSG is a noun phrase for the type of files being marked.
740 ;; It should end with a noun that can be pluralized by adding `s'.
741 ;; Return value is the number of files marked, or nil if none were marked.
742 (let ((temp-pt (make-symbol "pt"))
743 (temp-count (make-symbol "count"))
744 (temp-msg (make-symbol "msg")))
745 (` (let (((, temp-msg) (, msg))
746 ((, temp-count) 0)
747 (, temp-pt) buffer-read-only)
748 (save-excursion
749 (if (, temp-msg) (message "Marking %ss..." (, temp-msg)))
750 (goto-char (point-min))
751 (while (not (eobp))
752 (if (and (, predicate)
753 (not (char-equal (following-char) dired-marker-char)))
754 (progn
755 ;; Doing this rather than delete-char, insert
756 ;; avoids re-computing markers
757 (setq (, temp-pt) (point))
758 (dired-substitute-marker
759 (, temp-pt)
760 (following-char) dired-marker-char)
761 (setq (, temp-count) (1+ (, temp-count)))))
762 (forward-line 1))
763 (if (, temp-msg)
764 (message "%s %s%s %s%s."
765 (, temp-count)
766 (, temp-msg)
767 (dired-plural-s (, temp-count))
768 (if (eq dired-marker-char ?\040) "un" "")
769 (if (eq dired-marker-char dired-del-marker)
770 "flagged" "marked"))))
771 (and (> (, temp-count) 0) (, temp-count))))))
772
773 (defmacro dired-map-over-marks (body arg &optional show-progress)
774 ;; Perform BODY with point somewhere on each marked line
775 ;; and return a list of BODY's results.
776 ;; If no marked file could be found, execute BODY on the current line.
777 ;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
778 ;; files instead of the marked files.
779 ;; If ARG is t, only apply to marked files. If there are no marked files,
780 ;; the result is a noop.
781 ;; If ARG is otherwise non-nil, use current file instead.
782 ;; If optional third arg SHOW-PROGRESS evaluates to non-nil,
783 ;; redisplay the dired buffer after each file is processed.
784 ;; No guarantee is made about the position on the marked line.
785 ;; BODY must ensure this itself if it depends on this.
786 ;; Search starts at the beginning of the buffer, thus the car of the list
787 ;; corresponds to the line nearest to the buffer's bottom. This
788 ;; is also true for (positive and negative) integer values of ARG.
789 ;; To avoid code explosion, BODY should not be too long as it is
790 ;; expanded four times.
791 ;;
792 ;; Warning: BODY must not add new lines before point - this may cause an
793 ;; endless loop.
794 ;; This warning should not apply any longer, sk 2-Sep-1991 14:10.
795 (let ((temp-found (make-symbol "found"))
796 (temp-results (make-symbol "results"))
797 (temp-regexp (make-symbol "regexp"))
798 (temp-curr-pt (make-symbol "curr-pt"))
799 (temp-next-position (make-symbol "next-position")))
800 (` (let (buffer-read-only case-fold-search (, temp-found) (, temp-results))
801 (dired-save-excursion
802 (if (and (, arg) (not (eq (, arg) t)))
803 (if (integerp (, arg))
804 (and (not (zerop (, arg)))
805 (progn;; no save-excursion, want to move point.
806 (dired-repeat-over-lines
807 arg
808 (function (lambda ()
809 (if (, show-progress) (sit-for 0))
810 (setq (, temp-results)
811 (cons (, body)
812 (, temp-results))))))
813 (if (< (, arg) 0)
814 (nreverse (, temp-results))
815 (, temp-results))))
816 ;; non-nil, non-integer ARG means use current file:
817 (list (, body)))
818 (let (((, temp-regexp)
819 (concat "^" (regexp-quote (char-to-string
820 dired-marker-char))))
821 (, temp-curr-pt) (, temp-next-position))
822 (save-excursion
823 (goto-char (point-min))
824 ;; remember position of next marked file before BODY
825 ;; can insert lines before the just found file,
826 ;; confusing us by finding the same marked file again
827 ;; and again and...
828 (setq (, temp-next-position)
829 (and (re-search-forward (, temp-regexp) nil t)
830 (point-marker))
831 (, temp-found) (not (null (, temp-next-position))))
832 (while (, temp-next-position)
833 (setq (, temp-curr-pt) (goto-char (, temp-next-position))
834 ;; need to get next position BEFORE body
835 (, temp-next-position)
836 (and (re-search-forward (, temp-regexp) nil t)
837 (point-marker)))
838 (goto-char (, temp-curr-pt))
839 (if (, show-progress) (sit-for 0))
840 (setq (, temp-results) (cons (, body) (, temp-results)))))
841 (if (, temp-found)
842 (, temp-results)
843 ;; Do current file, unless arg is t
844 (and (not (eq (, arg) t))
845 (list (, body)))))))))))
846
847 ;;; General utility functions
848
849 (defun dired-buffer-more-recently-used-p (buffer1 buffer2)
850 "Return t if BUFFER1 is more recently used than BUFFER2."
851 (if (equal buffer1 buffer2)
852 nil
853 (let ((more-recent nil)
854 (list (buffer-list)))
855 (while (and list
856 (not (setq more-recent (equal buffer1 (car list))))
857 (not (equal buffer2 (car list))))
858 (setq list (cdr list)))
859 more-recent)))
860
861 (defun dired-file-modtime (file)
862 ;; Return the modtime of FILE, which is assumed to be already expanded
863 ;; by expand-file-name.
864 (let ((handler (find-file-name-handler file 'dired-file-modtime)))
865 (if handler
866 (funcall handler 'dired-file-modtime file)
867 (nth 5 (file-attributes file)))))
868
869 (defun dired-set-file-modtime (file alist)
870 ;; Set the modtime for FILE in the subdir alist ALIST.
871 (let ((handler (find-file-name-handler file 'dired-set-file-modtime)))
872 (if handler
873 (funcall handler 'dired-set-file-modtime file alist)
874 (let ((elt (assoc file alist)))
875 (if elt
876 (setcar (nthcdr 4 elt) (nth 5 (file-attributes file))))))))
877
878 (defun dired-map-over-marks-check (fun arg op-symbol operation
879 &optional show-progress no-confirm)
880 ;; Map FUN over marked files (with second ARG like in dired-map-over-marks)
881 ;; and display failures.
882
883 ;; FUN takes zero args. It returns non-nil (the offending object, e.g.
884 ;; the short form of the filename) for a failure and probably logs a
885 ;; detailed error explanation using function `dired-log'.
886
887 ;; OP-SYMBOL is s symbol representing the operation.
888 ;; eg. 'compress
889
890 ;; OPERATION is a string describing the operation performed (e.g.
891 ;; "Compress"). It is used with `dired-mark-pop-up' to prompt the user
892 ;; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
893 ;; `Failed to compress 1 of 2 files - type y to see why ("foo")')
894
895 ;; SHOW-PROGRESS if non-nil means redisplay dired after each file.
896
897 (if (or no-confirm (dired-mark-confirm op-symbol operation arg))
898 (let* ((total-list;; all of FUN's return values
899 (dired-map-over-marks (funcall fun) arg show-progress))
900 (total (length total-list))
901 (failures (delq nil total-list))
902 (count (length failures)))
903 (if (not failures)
904 (message "%s: %d file%s." operation total (dired-plural-s total))
905 (message "Failed to %s %d of %d file%s - type y to see why %s"
906 operation count total (dired-plural-s total)
907 ;; this gives a short list of failed files in parens
908 ;; which may be sufficient for the user even
909 ;; without typing `W' for the process' diagnostics
910 failures)
911 ;; end this bunch of errors:
912 (dired-log-summary
913 (buffer-name (current-buffer))
914 (format
915 "Failed to %s %d of %d file%s"
916 operation count total (dired-plural-s total))
917 failures)))))
918
919 (defun dired-make-switches-string (list)
920 ;; Converts a list of cracters to a string suitable for passing to ls.
921 (concat "-" (mapconcat 'char-to-string list "")))
922
923 (defun dired-make-switches-list (string)
924 ;; Converts a string of ls switches to a list of characters.
925 (delq ?- (mapcar 'identity string)))
926
927 ;; Cloning replace-match to work on strings instead of in buffer:
928 ;; The FIXEDCASE parameter of replace-match is not implemented.
929 (defun dired-string-replace-match (regexp string newtext
930 &optional literal global)
931 ;; Replace first match of REGEXP in STRING with NEWTEXT.
932 ;; If it does not match, nil is returned instead of the new string.
933 ;; Optional arg LITERAL means to take NEWTEXT literally.
934 ;; Optional arg GLOBAL means to replace all matches.
935 (if global
936 (let ((result "") (start 0) mb me)
937 (while (string-match regexp string start)
938 (setq mb (match-beginning 0)
939 me (match-end 0)
940 result (concat result
941 (substring string start mb)
942 (if literal
943 newtext
944 (dired-expand-newtext string newtext)))
945 start me))
946 (if mb ; matched at least once
947 (concat result (substring string start))
948 nil))
949 ;; not GLOBAL
950 (if (not (string-match regexp string 0))
951 nil
952 (concat (substring string 0 (match-beginning 0))
953 (if literal newtext (dired-expand-newtext string newtext))
954 (substring string (match-end 0))))))
955
956 (defun dired-expand-newtext (string newtext)
957 ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
958 ;; Note that in Emacs 18 match data are clipped to current buffer
959 ;; size...so the buffer should better not be smaller than STRING.
960 (let ((pos 0)
961 (len (length newtext))
962 (expanded-newtext ""))
963 (while (< pos len)
964 (setq expanded-newtext
965 (concat expanded-newtext
966 (let ((c (aref newtext pos)))
967 (if (= ?\\ c)
968 (cond ((= ?\& (setq c
969 (aref newtext
970 (setq pos (1+ pos)))))
971 (substring string
972 (match-beginning 0)
973 (match-end 0)))
974 ((and (>= c ?1) (<= c ?9))
975 ;; return empty string if N'th
976 ;; sub-regexp did not match:
977 (let ((n (- c ?0)))
978 (if (match-beginning n)
979 (substring string
980 (match-beginning n)
981 (match-end n))
982 "")))
983 (t
984 (char-to-string c)))
985 (char-to-string c)))))
986 (setq pos (1+ pos)))
987 expanded-newtext))
988
989 (defun dired-in-this-tree (file dir)
990 ;;Is FILE part of the directory tree starting at DIR?
991 (let ((len (length dir)))
992 (and (>= (length file) len)
993 (string-equal (substring file 0 len) dir))))
994
995 (defun dired-tree-lessp (dir1 dir2)
996 ;; Lexicographic order on pathname components, like `ls -lR':
997 ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
998 ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
999 ;; or DIR1 and DIR2 are in the same parentdir and their last
1000 ;; components are string-lessp.
1001 ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
1002 ;; string-lessp could arguably be replaced by file-newer-than-file-p
1003 ;; if dired-internal-switches contained `t'.
1004 (let ((dir1 (file-name-as-directory dir1))
1005 (dir2 (file-name-as-directory dir2))
1006 (start1 1)
1007 (start2 1)
1008 comp1 comp2 end1 end2)
1009 (while (progn
1010 (setq end1 (string-match "/" dir1 start1)
1011 comp1 (substring dir1 start1 end1)
1012 end2 (string-match "/" dir2 start2)
1013 comp2 (substring dir2 start2 end2))
1014 (and end1 end2 (string-equal comp1 comp2)))
1015 (setq start1 (1+ end1)
1016 start2 (1+ end2)))
1017 (if (eq (null end1) (null end2))
1018 (string-lessp comp1 comp2)
1019 (null end1))))
1020
1021 ;; So that we can support case-insensitive systems.
1022 (fset 'dired-file-name-lessp 'string-lessp)
1023
1024
1025 ;;;; ------------------------------------------------------------------
1026 ;;;; Initializing Dired
1027 ;;;; ------------------------------------------------------------------
1028
1029 ;;; Set the minor mode alist
1030
1031 (or (equal (assq 'dired-sort-mode minor-mode-alist)
1032 '(dired-sort-mode dired-sort-mode))
1033 ;; Test whether this has already been done in case dired is reloaded
1034 ;; There may be several elements with dired-sort-mode as car.
1035 (setq minor-mode-alist
1036 ;; cons " Omit" in first, so that it doesn't
1037 ;; get stuck between the directory and sort mode on the
1038 ;; mode line.
1039 (cons '(dired-sort-mode dired-sort-mode)
1040 (cons '(dired-subdir-omit " Omit")
1041 (cons '(dired-marker-stack dired-marker-string)
1042 minor-mode-alist)))))
1043
1044 ;;; Keymaps
1045
1046 (defvar dired-mode-map nil
1047 "Local keymap for dired-mode buffers.")
1048 (defvar dired-regexp-map nil
1049 "Dired keymap for commands that use regular expressions.")
1050 (defvar dired-diff-map nil
1051 "Dired keymap for diff and related commands.")
1052 (defvar dired-subdir-map nil
1053 "Dired keymap for commands that act on subdirs, or the files within them.")
1054
1055 (defvar dired-keymap-grokked nil
1056 "Set to t after dired has grokked the global keymap.")
1057
1058 (defun dired-key-description (cmd &rest prefixes)
1059 ;; Return a key description string for a menu. If prefixes are given,
1060 ;; they should be either strings, integers, or 'universal-argument.
1061 (let ((key (where-is-internal cmd dired-mode-map t)))
1062 (if key
1063 (key-description
1064 (apply 'vconcat
1065 (append
1066 (mapcar
1067 (function
1068 (lambda (x)
1069 (cond ((eq x 'universal-argument)
1070 (where-is-internal 'universal-argument
1071 dired-mode-map t))
1072 ((integerp x) (int-to-string x))
1073 (t x))))
1074 prefixes)
1075 (list key))))
1076 "")))
1077
1078 (defun dired-grok-keys (to-command from-command)
1079 ;; Assigns to TO-COMMAND the keys for the global binding of FROM-COMMAND.
1080 ;; Does not clobber anything in the local keymap. In emacs 19 should
1081 ;; use substitute-key-definition, but I believe that this will
1082 ;; clobber things in the local map.
1083 (let ((keys (where-is-internal from-command)))
1084 (while keys
1085 (condition-case nil
1086 (if (eq (global-key-binding (car keys)) (key-binding (car keys)))
1087 (local-set-key (car keys) to-command))
1088 (error nil))
1089 (setq keys (cdr keys)))))
1090
1091 (defun dired-grok-keymap ()
1092 ;; Initialize the dired keymaps.
1093 ;; This is actually done the first time that dired-mode runs.
1094 ;; We do it this late, to be sure that the user's global-keymap has
1095 ;; stabilized.
1096 (if dired-keymap-grokked
1097 () ; we've done it
1098 ;; Watch out for dired being invoked from the command line.
1099 ;; This is a bit kludgy, but so is the emacs startup sequence IMHO.
1100 (if (and term-setup-hook (boundp 'command-line-args-left))
1101 (progn
1102 (if (string-equal "18." (substring emacs-version 0 3))
1103 (funcall term-setup-hook)
1104 (run-hooks 'term-setup-hook))
1105 (setq term-setup-hook nil)))
1106 (setq dired-keymap-grokked t)
1107 (run-hooks 'dired-setup-keys-hook)
1108 (dired-grok-keys 'dired-next-line 'next-line)
1109 (dired-grok-keys 'dired-previous-line 'previous-line)
1110 (dired-grok-keys 'dired-undo 'undo)
1111 (dired-grok-keys 'dired-undo 'advertised-undo)
1112 (dired-grok-keys 'dired-scroll-up 'scroll-up)
1113 (dired-grok-keys 'dired-scroll-down 'scroll-down)
1114 (dired-grok-keys 'dired-beginning-of-buffer 'beginning-of-buffer)
1115 (dired-grok-keys 'dired-end-of-buffer 'end-of-buffer)
1116 (dired-grok-keys 'dired-next-subdir 'forward-paragraph)
1117 (dired-grok-keys 'dired-prev-subdir 'backward-paragraph)))
1118
1119 ;; The regexp-map is used for commands using regexp's.
1120 (if dired-regexp-map
1121 ()
1122 (setq dired-regexp-map (make-sparse-keymap))
1123 (define-key dired-regexp-map "C" 'dired-do-copy-regexp)
1124 ;; Not really a regexp, but does transform file names.
1125 (define-key dired-regexp-map "D" 'dired-downcase)
1126 (define-key dired-regexp-map "H" 'dired-do-hardlink-regexp)
1127 (define-key dired-regexp-map "R" 'dired-do-rename-regexp)
1128 (define-key dired-regexp-map "S" 'dired-do-symlink-regexp)
1129 (define-key dired-regexp-map "U" 'dired-upcase)
1130 (define-key dired-regexp-map "Y" 'dired-do-relsymlink-regexp)
1131 (define-key dired-regexp-map "c" 'dired-cleanup)
1132 (define-key dired-regexp-map "d" 'dired-flag-files-regexp)
1133 (define-key dired-regexp-map "e" 'dired-mark-extension)
1134 (define-key dired-regexp-map "m" 'dired-mark-files-regexp)
1135 (define-key dired-regexp-map "o" 'dired-add-omit-regexp)
1136 (define-key dired-regexp-map "x" 'dired-flag-extension)) ; a string, rather
1137 ; than a regexp.
1138
1139 (if dired-diff-map
1140 ()
1141 (setq dired-diff-map (make-sparse-keymap))
1142 (define-key dired-diff-map "d" 'dired-diff)
1143 (define-key dired-diff-map "b" 'dired-backup-diff)
1144 (define-key dired-diff-map "m" 'dired-emerge)
1145 (define-key dired-diff-map "a" 'dired-emerge-with-ancestor)
1146 (define-key dired-diff-map "e" 'dired-ediff)
1147 (define-key dired-diff-map "p" 'dired-epatch))
1148
1149 (if dired-subdir-map
1150 ()
1151 (setq dired-subdir-map (make-sparse-keymap))
1152 (define-key dired-subdir-map "n" 'dired-redisplay-subdir)
1153 (define-key dired-subdir-map "m" 'dired-mark-subdir-files)
1154 (define-key dired-subdir-map "d" 'dired-flag-subdir-files)
1155 (define-key dired-subdir-map "z" 'dired-compress-subdir-files))
1156
1157 (fset 'dired-regexp-prefix dired-regexp-map)
1158 (fset 'dired-diff-prefix dired-diff-map)
1159 (fset 'dired-subdir-prefix dired-subdir-map)
1160 (fset 'efs-dired-prefix (function (lambda ()
1161 (interactive)
1162 (error "efs-dired not loaded yet"))))
1163
1164 ;; the main map
1165 (if dired-mode-map
1166 nil
1167 ;; Force `f' rather than `e' in the mode doc:
1168 (fset 'dired-advertised-find-file 'dired-find-file)
1169 (fset 'dired-advertised-next-subdir 'dired-next-subdir)
1170 (fset 'dired-advertised-prev-subdir 'dired-prev-subdir)
1171 (setq dired-mode-map (make-keymap))
1172 (suppress-keymap dired-mode-map)
1173 ;; Commands to mark certain categories of files
1174 (define-key dired-mode-map "~" 'dired-flag-backup-files)
1175 (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
1176 (define-key dired-mode-map "*" 'dired-mark-executables)
1177 (define-key dired-mode-map "." 'dired-clean-directory)
1178 (define-key dired-mode-map "/" 'dired-mark-directories)
1179 (define-key dired-mode-map "@" 'dired-mark-symlinks)
1180 (define-key dired-mode-map "," 'dired-mark-rcs-files)
1181 (define-key dired-mode-map "\M-(" 'dired-mark-sexp)
1182 (define-key dired-mode-map "\M-d" 'dired-mark-files-from-other-dired-buffer)
1183 (define-key dired-mode-map "\M-c" 'dired-mark-files-compilation-buffer)
1184 ;; Upper case keys (except ! and &) for operating on the marked files
1185 (define-key dired-mode-map "A" 'dired-do-tags-search)
1186 (define-key dired-mode-map "B" 'dired-do-byte-compile)
1187 (define-key dired-mode-map "C" 'dired-do-copy)
1188 (define-key dired-mode-map "E" 'dired-do-grep)
1189 (define-key dired-mode-map "F" 'dired-do-find-file)
1190 (define-key dired-mode-map "G" 'dired-do-chgrp)
1191 (define-key dired-mode-map "H" 'dired-do-hardlink)
1192 (define-key dired-mode-map "I" 'dired-do-insert-subdir)
1193 (define-key dired-mode-map "K" 'dired-do-kill-file-lines)
1194 (define-key dired-mode-map "L" 'dired-do-load)
1195 (define-key dired-mode-map "M" 'dired-do-chmod)
1196 (define-key dired-mode-map "N" 'dired-do-redisplay)
1197 (define-key dired-mode-map "O" 'dired-do-chown)
1198 (define-key dired-mode-map "P" 'dired-do-print)
1199 (define-key dired-mode-map "Q" 'dired-do-tags-query-replace)
1200 (define-key dired-mode-map "R" 'dired-do-rename)
1201 (define-key dired-mode-map "S" 'dired-do-symlink)
1202 (define-key dired-mode-map "T" 'dired-do-total-size)
1203 (define-key dired-mode-map "U" 'dired-do-uucode)
1204 (define-key dired-mode-map "W" 'dired-copy-filenames-as-kill)
1205 (define-key dired-mode-map "X" 'dired-do-delete)
1206 (define-key dired-mode-map "Y" 'dired-do-relsymlink)
1207 (define-key dired-mode-map "Z" 'dired-do-compress)
1208 (define-key dired-mode-map "!" 'dired-do-shell-command)
1209 (define-key dired-mode-map "&" 'dired-do-background-shell-command)
1210 ;; Make all regexp commands share a `%' prefix:
1211 (define-key dired-mode-map "%" 'dired-regexp-prefix)
1212 ;; Lower keys for commands not operating on all the marked files
1213 (define-key dired-mode-map "a" 'dired-apropos)
1214 (define-key dired-mode-map "c" 'dired-change-marks)
1215 (define-key dired-mode-map "d" 'dired-flag-file-deletion)
1216 (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion-backup)
1217 (define-key dired-mode-map "e" 'dired-find-file)
1218 (define-key dired-mode-map "f" 'dired-advertised-find-file)
1219 (define-key dired-mode-map "g" 'revert-buffer)
1220 (define-key dired-mode-map "h" 'dired-describe-mode)
1221 (define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
1222 (define-key dired-mode-map "k" 'dired-kill-subdir)
1223 (define-key dired-mode-map "m" 'dired-mark)
1224 (define-key dired-mode-map "o" 'dired-find-file-other-window)
1225 (define-key dired-mode-map "q" 'dired-quit)
1226 (define-key dired-mode-map "r" 'dired-read-mail)
1227 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit)
1228 (define-key dired-mode-map "t" 'dired-get-target-directory)
1229 (define-key dired-mode-map "u" 'dired-unmark)
1230 (define-key dired-mode-map "v" 'dired-view-file)
1231 (define-key dired-mode-map "w" (if (fboundp 'find-file-other-frame)
1232 'dired-find-file-other-frame
1233 'dired-find-file-other-window))
1234 (define-key dired-mode-map "x" 'dired-expunge-deletions)
1235 (define-key dired-mode-map "y" 'dired-why)
1236 (define-key dired-mode-map "+" 'dired-create-directory)
1237 (define-key dired-mode-map "`" 'dired-recover-file)
1238 ;; dired-jump-back Should be in the global map, but put them here
1239 ;; too anyway.
1240 (define-key dired-mode-map "\C-x\C-j" 'dired-jump-back)
1241 (define-key dired-mode-map "\C-x4\C-j" 'dired-jump-back-other-window)
1242 (define-key dired-mode-map "\C-x5\C-j" 'dired-jump-back-other-frame)
1243 ;; Comparison commands
1244 (define-key dired-mode-map "=" 'dired-diff-prefix)
1245 ;; moving
1246 (define-key dired-mode-map "<" 'dired-prev-dirline)
1247 (define-key dired-mode-map ">" 'dired-next-dirline)
1248 (define-key dired-mode-map " " 'dired-next-line)
1249 (define-key dired-mode-map "n" 'dired-next-line)
1250 (define-key dired-mode-map "\C-n" 'dired-next-line)
1251 (define-key dired-mode-map "p" 'dired-previous-line)
1252 (define-key dired-mode-map "\C-p" 'dired-previous-line)
1253 (define-key dired-mode-map "\C-v" 'dired-scroll-up)
1254 (define-key dired-mode-map "\M-v" 'dired-scroll-down)
1255 (define-key dired-mode-map "\M-<" 'dired-beginning-of-buffer)
1256 (define-key dired-mode-map "\M->" 'dired-end-of-buffer)
1257 ;; This is silly, I'm changing it. -sb
1258 ;; (define-key dired-mode-map "\C-m" 'dired-goto-file)
1259 (define-key dired-mode-map "\C-m" 'dired-advertised-find-file)
1260 ;; motion by subdirectories
1261 (define-key dired-mode-map "^" 'dired-up-directory)
1262 (define-key dired-mode-map "\M-\C-u" 'dired-up-directory)
1263 (define-key dired-mode-map "\M-\C-d" 'dired-down-directory)
1264 (define-key dired-mode-map "\M-\C-n" 'dired-advertised-next-subdir)
1265 (define-key dired-mode-map "\M-\C-p" 'dired-advertised-prev-subdir)
1266 (define-key dired-mode-map "\C-j" 'dired-goto-subdir)
1267 ;; move to marked files
1268 (define-key dired-mode-map "\M-p" 'dired-prev-marked-file)
1269 (define-key dired-mode-map "\M-n" 'dired-next-marked-file)
1270 ;; hiding
1271 (define-key dired-mode-map "$" 'dired-hide-subdir)
1272 (define-key dired-mode-map "\M-$" 'dired-hide-all)
1273 ;; omitting
1274 (define-key dired-mode-map "\C-o" 'dired-omit-toggle)
1275 ;; markers
1276 (define-key dired-mode-map "\(" 'dired-set-marker-char)
1277 (define-key dired-mode-map "\)" 'dired-restore-marker-char)
1278 (define-key dired-mode-map "'" 'dired-marker-stack-left)
1279 (define-key dired-mode-map "\\" 'dired-marker-stack-right)
1280 ;; misc
1281 (define-key dired-mode-map "\C-i" 'dired-mark-prefix)
1282 (define-key dired-mode-map "?" 'dired-summary)
1283 (define-key dired-mode-map "\177" 'dired-backup-unflag)
1284 (define-key dired-mode-map "\C-_" 'dired-undo)
1285 (define-key dired-mode-map "\C-xu" 'dired-undo)
1286 (define-key dired-mode-map "\M-\C-?" 'dired-unmark-all-files)
1287 ;; The subdir map
1288 (define-key dired-mode-map "|" 'dired-subdir-prefix)
1289 ;; efs submap
1290 (define-key dired-mode-map "\M-e" 'efs-dired-prefix))
1291
1292
1293
1294 ;;;;------------------------------------------------------------------
1295 ;;;; The dired command
1296 ;;;;------------------------------------------------------------------
1297
1298 ;;; User commands:
1299 ;;; All of these commands should have a binding in the global keymap.
1300
1301 ;;;###autoload (define-key ctl-x-map "d" 'dired)
1302 ;;;###autoload
1303 (defun dired (dirname &optional switches)
1304 "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
1305 Optional second argument SWITCHES specifies the `ls' options used.
1306 \(Interactively, use a prefix argument to be able to specify SWITCHES.)
1307 Dired displays a list of files in DIRNAME (which may also have
1308 shell wildcards appended to select certain files). If DIRNAME is a cons,
1309 its first element is taken as the directory name and the resr as an explicit
1310 list of files to make directory entries for.
1311 \\<dired-mode-map>\
1312 You can move around in it with the usual commands.
1313 You can flag files for deletion with \\[dired-flag-file-deletion] and then
1314 delete them by typing \\[dired-expunge-deletions].
1315 Type \\[dired-describe-mode] after entering dired for more info.
1316
1317 If DIRNAME is already in a dired buffer, that buffer is used without refresh."
1318 ;; Cannot use (interactive "D") because of wildcards.
1319 (interactive (dired-read-dir-and-switches ""))
1320 (switch-to-buffer (dired-noselect dirname switches)))
1321
1322 ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
1323 ;;;###autoload
1324 (defun dired-other-window (dirname &optional switches)
1325 "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
1326 (interactive (dired-read-dir-and-switches "in other window "))
1327 (switch-to-buffer-other-window (dired-noselect dirname switches)))
1328
1329 ;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
1330 ;;;###autoload
1331 (defun dired-other-frame (dirname &optional switches)
1332 "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
1333 (interactive (dired-read-dir-and-switches "in other frame "))
1334 (switch-to-buffer-other-frame (dired-noselect dirname switches)))
1335
1336 ;;;###autoload
1337 (defun dired-noselect (dir-or-list &optional switches)
1338 "Like `dired' but returns the dired buffer as value, does not select it."
1339 (or dir-or-list (setq dir-or-list (expand-file-name default-directory)))
1340 ;; This loses the distinction between "/foo/*/" and "/foo/*" that
1341 ;; some shells make:
1342 (let (dirname)
1343 (if (consp dir-or-list)
1344 (setq dirname (car dir-or-list))
1345 (setq dirname dir-or-list))
1346 (setq dirname (expand-file-name (directory-file-name dirname)))
1347 (if (file-directory-p dirname)
1348 (setq dirname (file-name-as-directory dirname)))
1349 (if (consp dir-or-list)
1350 (setq dir-or-list (cons dirname (cdr dir-or-list)))
1351 (setq dir-or-list dirname))
1352 (dired-internal-noselect dir-or-list switches)))
1353
1354 ;; Adapted from code by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
1355 ;;;###autoload (define-key ctl-x-map "\C-j" 'dired-jump-back)
1356 ;;;###autoload
1357 (defun dired-jump-back ()
1358 "Jump back to dired.
1359 If in a file, dired the current directory and move to file's line.
1360 If in dired already, pop up a level and goto old directory's line.
1361 In case the proper dired file line cannot be found, refresh the dired
1362 buffer and try again."
1363 (interactive)
1364 (let* ((file (if (eq major-mode 'dired-mode)
1365 (directory-file-name (dired-current-directory))
1366 buffer-file-name))
1367 (dir (if file
1368 (file-name-directory file)
1369 default-directory)))
1370 (dired dir)
1371 (if file (dired-really-goto-file file))))
1372
1373 ;;;###autoload (define-key ctl-x-4-map "\C-j" 'dired-jump-back-other-window)
1374 ;;;###autoload
1375 (defun dired-jump-back-other-window ()
1376 "Like \\[dired-jump-back], but to other window."
1377 (interactive)
1378 (let* ((file (if (eq major-mode 'dired-mode)
1379 (directory-file-name (dired-current-directory))
1380 buffer-file-name))
1381 (dir (if file
1382 (file-name-directory file)
1383 default-directory)))
1384 (dired-other-window dir)
1385 (if file (dired-really-goto-file file))))
1386
1387 ;;;###autoload (define-key ctl-x-5-map "\C-j" 'dired-jump-back-other-frame)
1388 ;;;###autoload
1389 (defun dired-jump-back-other-frame ()
1390 "Like \\[dired-jump-back], but in another frame."
1391 (interactive)
1392 (let* ((file (if (eq major-mode 'dired-mode)
1393 (directory-file-name (dired-current-directory))
1394 buffer-file-name))
1395 (dir (if file
1396 (file-name-directory file)
1397 default-directory)))
1398 (dired-other-frame dir)
1399 (if file (dired-really-goto-file file))))
1400
1401 ;;; Dired mode
1402
1403 ;; Dired mode is suitable only for specially formatted data.
1404 (put 'dired-mode 'mode-class 'special)
1405
1406 (defun dired-mode (&optional dirname switches)
1407 "\\<dired-mode-map>Dired mode is for \"editing\" directory trees.
1408
1409 For a simple one-line help message, type \\[dired-summary]
1410 For a moderately detailed description of dired mode, type \\[dired-describe-mode]
1411 For the full dired info tree, type \\[universal-argument] \\[dired-describe-mode]"
1412 ;; Not to be called interactively (e.g. dired-directory will be set
1413 ;; to default-directory, which is wrong with wildcards).
1414 (kill-all-local-variables)
1415 (use-local-map dired-mode-map)
1416 (setq major-mode 'dired-mode
1417 mode-name "Dired"
1418 case-fold-search nil
1419 buffer-read-only t
1420 selective-display t ; for subdirectory hiding
1421 selective-display-ellipses nil ; for omit toggling
1422 mode-line-buffer-identification '("Dired: %12b")
1423 mode-line-modified (format dired-mode-line-modified "--" "--" "-")
1424 dired-directory (expand-file-name (or dirname default-directory))
1425 dired-internal-switches (dired-make-switches-list
1426 (or switches dired-listing-switches)))
1427 (dired-advertise) ; default-directory is already set
1428 (set (make-local-variable 'revert-buffer-function)
1429 (function dired-revert))
1430 (set (make-local-variable 'default-directory-function)
1431 'dired-current-directory)
1432 (set (make-local-variable 'page-delimiter)
1433 "\n\n")
1434 (set (make-local-variable 'list-buffers-directory)
1435 dired-directory)
1436 ;; Will only do something in Emacs 19.
1437 (add-hook (make-local-variable 'kill-buffer-hook)
1438 'dired-unadvertise-current-buffer)
1439 ;; Same here
1440 (if window-system
1441 (add-hook (make-local-variable 'post-command-hook)
1442 (function
1443 (lambda ()
1444 (if (memq this-command dired-modeline-tracking-cmds)
1445 (dired-update-mode-line t))))))
1446 (dired-sort-other dired-internal-switches t)
1447 (dired-hack-local-variables)
1448 (run-hooks 'dired-mode-hook)
1449 ;; Run this after dired-mode-hook, in case that hook makes changes to
1450 ;; the keymap.
1451 (dired-grok-keymap))
1452
1453 ;;; Internal functions for starting dired
1454
1455 (defun dired-read-dir-and-switches (str)
1456 ;; For use in interactive.
1457 (reverse (list
1458 (if current-prefix-arg
1459 (read-string "Dired listing switches: "
1460 dired-listing-switches))
1461 (let ((default-directory (default-directory)))
1462 (read-file-name (format "Dired %s(directory): " str)
1463 nil default-directory nil)))))
1464
1465 (defun dired-hack-local-variables ()
1466 "Parse, bind or evaluate any local variables for current dired buffer.
1467 See variable `dired-local-variables-file'."
1468 (if (and dired-local-variables-file
1469 (file-exists-p dired-local-variables-file))
1470 (let (buffer-read-only opoint )
1471 (save-excursion
1472 (goto-char (point-max))
1473 (setq opoint (point-marker))
1474 (insert "\^L\n")
1475 (insert-file-contents dired-local-variables-file))
1476 (let ((buffer-file-name dired-local-variables-file))
1477 (condition-case err
1478 (hack-local-variables)
1479 (error (message "Error in dired-local-variables-file: %s" err)
1480 (sit-for 1))))
1481 ;; Must delete it as (eobp) is often used as test for last
1482 ;; subdir in dired.el.
1483 (delete-region opoint (point-max))
1484 (set-marker opoint nil))))
1485
1486 ;; Separate function from dired-noselect for the sake of dired-vms.el.
1487 (defun dired-internal-noselect (dir-or-list &optional switches mode)
1488 ;; If there is an existing dired buffer for DIRNAME, just leave
1489 ;; buffer as it is (don't even call dired-revert).
1490 ;; This saves time especially for deep trees or with efs.
1491 ;; The user can type `g'easily, and it is more consistent with find-file.
1492 ;; But if SWITCHES are given they are probably different from the
1493 ;; buffer's old value, so call dired-sort-other, which does
1494 ;; revert the buffer.
1495 ;; If the user specifies a directory with emacs startup, eg.
1496 ;; emacs ~, dir-or-list may be unexpanded at this point.
1497
1498 (let* ((dirname (expand-file-name (if (consp dir-or-list)
1499 (car dir-or-list)
1500 dir-or-list)))
1501 (buffer (dired-find-buffer-nocreate dir-or-list mode))
1502 ;; note that buffer already is in dired-mode, if found
1503 (new-buffer-p (not buffer))
1504 (old-buf (current-buffer))
1505 wildcard)
1506 (or buffer
1507 (let ((default-major-mode 'fundamental-mode))
1508 ;; We don't want default-major-mode to run hooks and set auto-fill
1509 ;; or whatever, now that dired-mode does not
1510 ;; kill-all-local-variables any longer.
1511 (setq buffer (create-file-buffer (directory-file-name dirname)))))
1512 (set-buffer buffer)
1513 (if (not new-buffer-p) ; existing buffer ...
1514 (progn
1515 (if switches
1516 (dired-sort-other
1517 (if (stringp switches)
1518 (dired-make-switches-list switches)
1519 switches)))
1520 (if dired-verify-modtimes (dired-verify-modtimes))
1521 (if (and dired-find-subdir
1522 (not (string-equal (dired-current-directory)
1523 (file-name-as-directory dirname))))
1524 (dired-initial-position dirname)))
1525 ;; Else a new buffer
1526 (if (file-directory-p dirname)
1527 (setq default-directory dirname
1528 wildcard (consp dir-or-list))
1529 (setq default-directory (file-name-directory dirname)
1530 wildcard t))
1531 (or switches (setq switches dired-listing-switches))
1532 (dired-mode dirname switches)
1533 ;; default-directory and dired-internal-switches are set now
1534 ;; (buffer-local), so we can call dired-readin:
1535 (let ((failed t))
1536 (unwind-protect
1537 (progn (dired-readin dir-or-list buffer wildcard)
1538 (setq failed nil))
1539 ;; dired-readin can fail if parent directories are inaccessible.
1540 ;; Don't leave an empty buffer around in that case.
1541 (if failed (kill-buffer buffer))))
1542 ;; No need to narrow since the whole buffer contains just
1543 ;; dired-readin's output, nothing else. The hook can
1544 ;; successfully use dired functions (e.g. dired-get-filename)
1545 ;; as the subdir-alist has been built in dired-readin.
1546 (run-hooks 'dired-after-readin-hook)
1547 ;; I put omit-expunge after the dired-after-readin-hook
1548 ;; in case that hook marks files. Does this make sense? Also, users
1549 ;; might want to set dired-omit-files-p in some incredibly clever
1550 ;; way depending on the contents of the directory... I don't know...
1551 (if dired-omit-files
1552 (dired-omit-expunge nil t))
1553 (goto-char (point-min))
1554 (dired-initial-position dirname))
1555 (set-buffer old-buf)
1556 buffer))
1557
1558 (defun dired-find-buffer-nocreate (dir-or-list &optional mode)
1559 ;; Returns a dired buffer for DIR-OR-LIST. DIR-OR-LIST may be wildcard,
1560 ;; or a directory and alist of files.
1561 ;; If dired-find-subdir is non-nil, is satisfied with a dired
1562 ;; buffer containing DIR-OR-LIST as a subdirectory. If there is more
1563 ;; than one candidate, returns the most recently used.
1564 (if dired-find-subdir
1565 (let ((buffers (sort (delq (current-buffer)
1566 (dired-buffers-for-dir dir-or-list t))
1567 (function dired-buffer-more-recently-used-p))))
1568 (or (car buffers)
1569 ;; Couldn't find another buffer. Will the current one do?
1570 ;; It is up dired-initial-position to actually go to the subdir.
1571 (and (or (equal dir-or-list dired-directory) ; covers wildcards
1572 (and (stringp dir-or-list)
1573 (not (string-equal
1574 dir-or-list
1575 (expand-file-name default-directory)))
1576 (assoc (file-name-as-directory dir-or-list)
1577 dired-subdir-alist)))
1578 (current-buffer))))
1579 ;; Else just look through the buffer list.
1580 (let (found (blist (buffer-list)))
1581 (or mode (setq mode 'dired-mode))
1582 (save-excursion
1583 (while blist
1584 (set-buffer (car blist))
1585 (if (and (eq major-mode mode)
1586 (equal dired-directory dir-or-list))
1587 (setq found (car blist)
1588 blist nil)
1589 (setq blist (cdr blist)))))
1590 found)))
1591
1592 (defun dired-initial-position (dirname)
1593 ;; Where point should go in a new listing of DIRNAME.
1594 ;; Point assumed at beginning of new subdir line.
1595 (end-of-line)
1596 (if dired-find-subdir (dired-goto-subdir dirname))
1597 (if dired-trivial-filenames (dired-goto-next-nontrivial-file))
1598 (dired-update-mode-line t))
1599
1600 (defun dired-readin (dir-or-list buffer &optional wildcard)
1601 ;; Read in a new dired buffer
1602 ;; dired-readin differs from dired-insert-subdir in that it accepts
1603 ;; wildcards, erases the buffer, and builds the subdir-alist anew
1604 ;; (including making it buffer-local and clearing it first).
1605 ;; default-directory and dired-internal-switches must be buffer-local
1606 ;; and initialized by now.
1607 ;; Thus we can test (equal default-directory dirname) instead of
1608 ;; (file-directory-p dirname) and save a filesystem transaction.
1609 ;; This is wrong, if dired-before-readin-hook changes default-directory
1610 ;; Also, we can run this hook which may want to modify the switches
1611 ;; based on default-directory, e.g. with efs to a SysV host
1612 ;; where ls won't understand -Al switches.
1613 (let (dirname other-dirs)
1614 (if (consp dir-or-list)
1615 (setq dir-or-list (dired-frob-dir-list dir-or-list)
1616 other-dirs (cdr dir-or-list)
1617 dir-or-list (car dir-or-list)
1618 dirname (car dir-or-list))
1619 (setq dirname dir-or-list))
1620 (setq dirname (expand-file-name dirname))
1621 (if (consp dir-or-list)
1622 (setq dir-or-list (cons dirname (cdr dir-or-list))))
1623 (save-excursion
1624 (set-buffer buffer)
1625 (run-hooks 'dired-before-readin-hook)
1626 (message "Reading directory %s..." dirname)
1627 (let (buffer-read-only)
1628 (widen)
1629 (erase-buffer)
1630 (dired-readin-insert dir-or-list wildcard)
1631 (dired-indent-listing (point-min) (point-max))
1632 ;; We need this to make the root dir have a header line as all
1633 ;; other subdirs have:
1634 (goto-char (point-min))
1635 (dired-insert-headerline (expand-file-name default-directory)))
1636 (message "Reading directory %s...done" dirname)
1637 (set-buffer-modified-p nil)
1638 ;; Must first make alist buffer local and set it to nil because
1639 ;; dired-build-subdir-alist will call dired-clear-alist first
1640 (setq dired-subdir-alist nil)
1641 (if (memq ?R dired-internal-switches)
1642 (dired-build-subdir-alist)
1643 ;; no need to parse the buffer if listing is not recursive
1644 (dired-simple-subdir-alist))
1645 (if other-dirs
1646 (mapcar
1647 (function
1648 (lambda (x)
1649 (if (dired-in-this-tree (car x) dirname)
1650 (dired-insert-subdir x))))
1651 other-dirs)))))
1652
1653 ;;; Subroutines of dired-readin
1654
1655 (defun dired-readin-insert (dir-or-list &optional wildcard)
1656 ;; Just insert listing for the passed-in directory or
1657 ;; directory-and-file list, assuming a clean buffer.
1658 (let* ((switches (dired-make-switches-string dired-internal-switches))
1659 (dir-is-list (consp dir-or-list))
1660 (dirname (if dir-is-list (car dir-or-list) dir-or-list)))
1661 (if wildcard
1662 (progn
1663 (or (file-readable-p
1664 (if dir-is-list
1665 dirname
1666 (directory-file-name (file-name-directory dirname))))
1667 (error "Directory %s inaccessible or nonexistent" dirname))
1668 ;; else assume it contains wildcards
1669 (dired-insert-directory dir-or-list switches t)
1670 (save-excursion
1671 ;; insert wildcard instead of total line:
1672 (goto-char (point-min))
1673 (if dir-is-list
1674 (insert "list wildcard\n")
1675 (insert "wildcard " (file-name-nondirectory dirname) "\n"))))
1676 (dired-insert-directory dir-or-list switches nil t))))
1677
1678 (defun dired-insert-directory (dir-or-list switches &optional wildcard full-p)
1679 ;; Do the right thing whether dir-or-list is atomic or not. If it is,
1680 ;; insert all files listed in the cdr -- the car is the passed-in directory
1681 ;; list.
1682 (let ((opoint (point))
1683 (insert-directory-program dired-ls-program))
1684 (if (consp dir-or-list)
1685 (mapcar
1686 (function
1687 (lambda (x)
1688 (insert-directory x switches wildcard)))
1689 (cdr dir-or-list))
1690 (insert-directory dir-or-list switches wildcard full-p))
1691 (dired-insert-set-properties opoint (point)))
1692 (setq dired-directory dir-or-list))
1693
1694 (defun dired-frob-dir-list (dir-list)
1695 (let* ((top (file-name-as-directory (expand-file-name (car dir-list))))
1696 (tail (cdr dir-list))
1697 (result (list (list top)))
1698 elt dir)
1699 (setq tail
1700 (mapcar
1701 (function
1702 (lambda (x)
1703 (directory-file-name (expand-file-name x top))))
1704 tail))
1705 (while tail
1706 (setq dir (file-name-directory (car tail)))
1707 (if (setq elt (assoc dir result))
1708 (nconc elt (list (car tail)))
1709 (nconc result (list (list dir (car tail)))))
1710 (setq tail (cdr tail)))
1711 result))
1712
1713 (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
1714 ;; Insert DIR's headerline with no trailing slash, exactly like ls
1715 ;; would, and put cursor where dired-build-subdir-alist puts subdir
1716 ;; boundaries.
1717 (save-excursion (insert " " (directory-file-name dir) ":\n")))
1718
1719 (defun dired-verify-modtimes ()
1720 ;; Check the modtimes of all subdirs.
1721 (let ((alist dired-subdir-alist)
1722 on-disk in-mem badies)
1723 (while alist
1724 (and (setq in-mem (nth 4 (car alist)))
1725 (setq on-disk (dired-file-modtime (car (car alist))))
1726 (not (equal in-mem on-disk))
1727 (setq badies (cons (cons (car (car alist))
1728 (nth 3 (car alist)))
1729 badies)))
1730 (setq alist (cdr alist)))
1731 (and badies
1732 (let* ((ofile (dired-get-filename nil t))
1733 (osub (and (null ofile) (dired-get-subdir)))
1734 (opoint (point))
1735 (ocol (current-column)))
1736 (unwind-protect
1737 (and
1738 (or (memq 'revert-subdirs dired-no-confirm)
1739 (save-window-excursion
1740 (let ((flist (mapcar
1741 (function
1742 (lambda (f)
1743 (dired-abbreviate-file-name (car f))))
1744 badies)))
1745 (switch-to-buffer (current-buffer))
1746 (dired-mark-pop-up
1747 "*Stale Subdirectories*" 'revert-subdirs
1748 flist 'y-or-n-p
1749 (if (= (length flist) 1)
1750 (concat "Subdirectory " (car flist)
1751 " has changed on disk. Re-list? ")
1752 "Subdirectories have changed on disk. Re-list? "))
1753 )))
1754 (while badies
1755 (dired-insert-subdir (car (car badies))
1756 (cdr (car badies)) nil t)
1757 (setq badies (cdr badies))))
1758 ;; We can't use dired-save-excursion here, because we are
1759 ;; rewriting the entire listing, and not just changing a single
1760 ;; file line.
1761 (or (if ofile
1762 (dired-goto-file ofile)
1763 (if osub
1764 (dired-goto-subdir osub)))
1765 (progn
1766 (goto-char opoint)
1767 (beginning-of-line)
1768 (skip-chars-forward "^\n\r" (+ (point) ocol))))
1769 (dired-update-mode-line t)
1770 (dired-update-mode-line-modified t))))))
1771
1772 (defun dired-indent-listing (start end)
1773 ;; Indent a dired listing.
1774 (let (indent-tabs-mode)
1775 (indent-rigidly start end 2)
1776 ;; Quote any null lines that shouldn't be.
1777 (save-excursion
1778 (goto-char start)
1779 (while (search-forward "\n\n" end t)
1780 (forward-char -2)
1781 (if (looking-at dired-subdir-regexp)
1782 (goto-char (match-end 3))
1783 (progn
1784 (forward-char 1)
1785 (insert " ")))))))
1786
1787
1788 ;;;; ------------------------------------------------------------
1789 ;;;; Reverting a dired buffer, or specific file lines within it.
1790 ;;;; ------------------------------------------------------------
1791
1792 (defun dired-revert (&optional arg noconfirm)
1793 ;; Reread the dired buffer. Must also be called after
1794 ;; dired-internal-switches have changed.
1795 ;; Should not fail even on completely garbaged buffers.
1796 ;; Preserves old cursor, marks/flags, hidden-p.
1797 (widen) ; just in case user narrowed
1798 (let ((opoint (point))
1799 (ofile (dired-get-filename nil t))
1800 (hidden-subdirs (dired-remember-hidden))
1801 ;; switches for top-level dir
1802 (oswitches (or (nth 3 (nth (1- (length dired-subdir-alist))
1803 dired-subdir-alist))
1804 (delq ?R (copy-sequence dired-internal-switches))))
1805 ;; all other subdirs
1806 (old-subdir-alist (cdr (reverse dired-subdir-alist)))
1807 (omitted-subdirs (dired-remember-omitted))
1808 ;; do this after dired-remember-hidden, since this unhides
1809 (mark-alist (dired-remember-marks (point-min) (point-max)))
1810 (kill-files-p (save-excursion
1811 (goto-char (point))
1812 (search-forward
1813 (concat (char-to-string ?\r)
1814 (regexp-quote
1815 (char-to-string
1816 dired-kill-marker-char)))
1817 nil t)))
1818 buffer-read-only)
1819 ;; This is bogus, as it will not handle all the ways that efs uses cache.
1820 ;; Better to just use the fact that revert-buffer-function is a
1821 ;; buffer-local variable, and reset it to something that knows about
1822 ;; cache.
1823 ;; (dired-uncache
1824 ;; (if (consp dired-directory) (car dired-directory) dired-directory))
1825 ;; treat top level dir extra (it may contain wildcards)
1826 (let ((dired-after-readin-hook nil)
1827 ;; don't run that hook for each subdir...
1828 (dired-omit-files nil)
1829 (dired-internal-switches oswitches))
1830 (dired-readin dired-directory (current-buffer)
1831 ;; Don't test for wildcards by checking string=
1832 ;; default-directory and dired-directory
1833 ;; in case default-directory got munged.
1834 (or (consp dired-directory)
1835 (null (file-directory-p dired-directory))))
1836 ;; The R-switch will clobber sorting of subdirs.
1837 ;; What is the right thing to do here?
1838 (dired-insert-old-subdirs old-subdir-alist))
1839 (dired-mark-remembered mark-alist) ; mark files that were marked
1840 (if kill-files-p (dired-do-hide dired-kill-marker-char))
1841 (run-hooks 'dired-after-readin-hook) ; no need to narrow
1842 ;; omit-expunge after the readin hook
1843 (save-excursion
1844 (mapcar (function (lambda (dir)
1845 (if (dired-goto-subdir dir)
1846 (dired-omit-expunge))))
1847 omitted-subdirs))
1848 ;; hide subdirs that were hidden
1849 (save-excursion
1850 (mapcar (function (lambda (dir)
1851 (if (dired-goto-subdir dir)
1852 (dired-hide-subdir 1))))
1853 hidden-subdirs))
1854 ;; Try to get back to where we were
1855 (or (and ofile (dired-goto-file ofile))
1856 (goto-char opoint))
1857 (dired-move-to-filename)
1858 (dired-update-mode-line t)
1859 (dired-update-mode-line-modified t)))
1860
1861 (defun dired-do-redisplay (&optional arg)
1862 "Redisplay all marked (or next ARG) files."
1863 (interactive "P")
1864 ;; message instead of making dired-map-over-marks show-progress is
1865 ;; much faster
1866 (dired-map-over-marks (let ((fname (dired-get-filename)))
1867 (dired-uncache fname nil)
1868 (message "Redisplaying %s..." fname)
1869 (dired-update-file-line fname))
1870 arg)
1871 (dired-update-mode-line-modified t)
1872 (message "Redisplaying...done"))
1873
1874 (defun dired-redisplay-subdir (&optional arg)
1875 "Redisplay the current subdirectory.
1876 With a prefix prompts for listing switches."
1877 (interactive "P")
1878 (let ((switches (and arg (dired-make-switches-list
1879 (read-string "Switches for listing: "
1880 (dired-make-switches-string
1881 dired-internal-switches)))))
1882 (dir (dired-current-directory))
1883 (opoint (point))
1884 (ofile (dired-get-filename nil t)))
1885 (or switches
1886 (setq switches (nth 3 (assoc dir dired-subdir-alist))))
1887 (or switches
1888 (setq switches (delq ?R (copy-sequence dired-internal-switches))))
1889 (message "Redisplaying %s..." dir)
1890 (dired-uncache dir t)
1891 (dired-insert-subdir dir switches)
1892 (dired-update-mode-line-modified t)
1893 (or (and ofile (dired-goto-file ofile)) (goto-char opoint))
1894 (message "Redisplaying %s... done" dir)))
1895
1896 (defun dired-update-file-line (file)
1897 ;; Delete the current line, and insert an entry for FILE.
1898 ;; Does not update other dired buffers. Use dired-relist-file for that.
1899 (let* ((start (save-excursion (skip-chars-backward "^\n\r") (point)))
1900 (char (char-after start)))
1901 (dired-save-excursion
1902 ;; don't remember omit marks
1903 (if (memq char (list ?\040 dired-omit-marker-char))
1904 (setq char nil))
1905 ;; Delete the current-line. Even though dired-add-entry will not
1906 ;; insert duplicates, the file for the current line may not be the same as
1907 ;; FILE. eg. dired-do-compress
1908 (delete-region (save-excursion (skip-chars-backward "^\n\r") (1- (point)))
1909 (progn (skip-chars-forward "^\n\r") (point)))
1910 ;; dired-add-entry inserts at the end of the previous line.
1911 (forward-char 1)
1912 (dired-add-entry file char t))))
1913
1914 ;;; Subroutines of dired-revert
1915 ;;; Some of these are also used when inserting subdirs.
1916
1917 ;; Don't want to remember omit marks, in case omission regexps
1918 ;; were changed, before the dired-revert. If we don't unhide
1919 ;; omitted files, we won't see their marks. Therefore we use
1920 ;; dired-omit-unhide-region.
1921
1922 (defun dired-remember-marks (beg end)
1923 ;; Return alist of files and their marks, from BEG to END.
1924 (if selective-display ; must unhide to make this work.
1925 (let (buffer-read-only)
1926 (subst-char-in-region (point-min) (point-max) ?\r ?\n)
1927 (dired-do-hide dired-omit-marker-char)))
1928 (let (fil chr alist)
1929 (save-excursion
1930 (goto-char beg)
1931 (while (re-search-forward dired-re-mark end t)
1932 (if (setq fil (dired-get-filename nil t))
1933 (setq chr (preceding-char)
1934 alist (cons (cons fil chr) alist)))))
1935 alist))
1936
1937 (defun dired-mark-remembered (alist)
1938 ;; Mark all files remembered in ALIST.
1939 (let (elt fil chr)
1940 (while alist
1941 (setq elt (car alist)
1942 alist (cdr alist)
1943 fil (car elt)
1944 chr (cdr elt))
1945 (if (dired-goto-file fil)
1946 (save-excursion
1947 (beginning-of-line)
1948 (dired-substitute-marker (point) (following-char) chr))))))
1949
1950 (defun dired-remember-hidden ()
1951 ;; Return a list of all hidden subdirs.
1952 (let ((l dired-subdir-alist) dir result min)
1953 (while l
1954 (setq dir (car (car l))
1955 min (dired-get-subdir-min (car l))
1956 l (cdr l))
1957 (if (and (>= min (point-min)) (<= min (point-max))
1958 (dired-subdir-hidden-p dir))
1959 (setq result (cons dir result))))
1960 result))
1961
1962 (defun dired-insert-old-subdirs (old-subdir-alist)
1963 ;; Try to insert all subdirs that were displayed before
1964 (let (elt dir switches)
1965 (while old-subdir-alist
1966 (setq elt (car old-subdir-alist)
1967 old-subdir-alist (cdr old-subdir-alist)
1968 dir (car elt)
1969 switches (or (nth 3 elt) dired-internal-switches))
1970 (condition-case ()
1971 (dired-insert-subdir dir switches)
1972 (error nil)))))
1973
1974 (defun dired-uncache (file dir-p)
1975 ;; Remove directory DIR from any directory cache.
1976 ;; If DIR-P is non-nil, then FILE is a directory
1977 (let ((handler (find-file-name-handler file 'dired-uncache)))
1978 (if handler
1979 (funcall handler 'dired-uncache file dir-p))))
1980
1981
1982 ;;;; -------------------------------------------------------------
1983 ;;;; Inserting subdirectories
1984 ;;;; -------------------------------------------------------------
1985
1986 (defun dired-maybe-insert-subdir (dirname &optional
1987 switches no-error-if-not-dir-p)
1988 "Insert this subdirectory into the same dired buffer.
1989 If it is already present, just move to it (type \\[dired-do-redisplay] to
1990 refresh), else inserts it at its natural place (as ls -lR would have done).
1991 With a prefix arg, you may edit the ls switches used for this listing.
1992 You can add `R' to the switches to expand the whole tree starting at
1993 this subdirectory.
1994 This function takes some pains to conform to ls -lR output."
1995 (interactive
1996 (list (dired-get-filename)
1997 (if current-prefix-arg
1998 (dired-make-switches-list
1999 (read-string "Switches for listing: "
2000 (dired-make-switches-string
2001 dired-internal-switches))))))
2002 (let ((opoint (point)))
2003 ;; We don't need a marker for opoint as the subdir is always
2004 ;; inserted *after* opoint.
2005 (setq dirname (file-name-as-directory dirname))
2006 (or (and (not switches)
2007 (dired-goto-subdir dirname))
2008 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
2009 ;; Push mark so that it's easy to find back. Do this after the
2010 ;; insert message so that the user sees the `Mark set' message.
2011 (push-mark opoint)))
2012
2013 (defun dired-insert-subdir (dir-or-list &optional
2014 switches no-error-if-not-dir-p no-posn)
2015 "Insert this subdirectory into the same dired buffer.
2016 If it is already present, overwrites previous entry,
2017 else inserts it at its natural place (as ls -lR would have done).
2018 With a prefix arg, you may edit the ls switches used for this listing.
2019 You can add `R' to the switches to expand the whole tree starting at
2020 this subdirectory.
2021 This function takes some pains to conform to ls -lR output."
2022 ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
2023 ;; Prospero where dired-ls does the right thing, but
2024 ;; file-directory-p has not been redefined.
2025 ;; SWITCHES should be a list.
2026 ;; If NO-POSN is non-nil, doesn't bother position the point at
2027 ;; the first nontrivial file line. This can be used as an efficiency
2028 ;; hack when calling this from a program.
2029 (interactive
2030 (list (dired-get-filename)
2031 (if current-prefix-arg
2032 (dired-make-switches-list
2033 (read-string "Switches for listing: "
2034 (dired-make-switches-string
2035 dired-internal-switches))))))
2036 (let ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list)))
2037 (setq dirname (file-name-as-directory (expand-file-name dirname)))
2038 (or (dired-in-this-tree dirname (expand-file-name default-directory))
2039 (error "%s: not in this directory tree" dirname))
2040 (or no-error-if-not-dir-p
2041 (file-directory-p dirname)
2042 (error "Attempt to insert a non-directory: %s" dirname))
2043 (if switches
2044 (or (dired-compatible-switches-p dired-internal-switches switches)
2045 (error "Cannot have subdirs with %s and %s switches together."
2046 (dired-make-switches-string dired-internal-switches)
2047 (dired-make-switches-string switches)))
2048 (setq switches dired-internal-switches))
2049 (let ((elt (assoc dirname dired-subdir-alist))
2050 mark-alist opoint-max buffer-read-only)
2051 (if (memq ?R switches)
2052 ;; avoid duplicated subdirs
2053 (progn
2054 (setq mark-alist (dired-kill-tree dirname t))
2055 (dired-insert-subdir-newpos dirname))
2056 (if elt
2057 ;; If subdir is already present, remove it and remember its marks
2058 (setq mark-alist (dired-insert-subdir-del elt))
2059 ;; else move to new position
2060 (dired-insert-subdir-newpos dirname)))
2061 (setq opoint-max (point-max))
2062 (condition-case nil
2063 (dired-insert-subdir-doupdate
2064 dirname (dired-insert-subdir-doinsert dir-or-list switches)
2065 switches elt mark-alist)
2066 (quit ; watch out for aborted inserts
2067 (and (= opoint-max (point-max))
2068 (null elt)
2069 (= (preceding-char) ?\n)
2070 (delete-char -1))
2071 (signal 'quit nil))))
2072 (or no-posn (dired-initial-position dirname))))
2073
2074 (defun dired-do-insert-subdir ()
2075 "Insert all marked subdirectories in situ that are not yet inserted.
2076 Non-directories are silently ignored."
2077 (interactive)
2078 (let ((files (or (dired-get-marked-files)
2079 (error "No files marked."))))
2080 (while files
2081 (if (file-directory-p (car files))
2082 (save-excursion (dired-maybe-insert-subdir (car files))))
2083 (setq files (cdr files)))))
2084
2085 ;;; Utilities for inserting subdirectories
2086
2087 (defun dired-insert-subdir-newpos (new-dir)
2088 ;; Find pos for new subdir, according to tree order.
2089 (let ((alist dired-subdir-alist) elt dir new-pos)
2090 (while alist
2091 (setq elt (car alist)
2092 alist (cdr alist)
2093 dir (car elt))
2094 (if (dired-tree-lessp dir new-dir)
2095 ;; Insert NEW-DIR after DIR
2096 (setq new-pos (dired-get-subdir-max elt)
2097 alist nil)))
2098 (goto-char new-pos))
2099 (insert "\n")
2100 (point))
2101
2102 (defun dired-insert-subdir-del (element)
2103 ;; Erase an already present subdir (given by ELEMENT) from buffer.
2104 ;; Move to that buffer position. Return a mark-alist.
2105 (let ((begin-marker (dired-get-subdir-min element)))
2106 (goto-char begin-marker)
2107 ;; Are at beginning of subdir (and inside it!). Now determine its end:
2108 (goto-char (dired-subdir-max))
2109 (prog1
2110 (dired-remember-marks begin-marker (point))
2111 (delete-region begin-marker (point)))))
2112
2113 (defun dired-insert-subdir-doinsert (dir-or-list switches)
2114 ;; Insert ls output after point and put point on the correct
2115 ;; position for the subdir alist.
2116 ;; Return the boundary of the inserted text (as list of BEG and END).
2117 ;; SWITCHES should be a non-nil list.
2118 (let ((begin (point))
2119 (dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
2120 end)
2121 (message "Reading directory %s..." dirname)
2122 (if (string-equal dirname (car (car (reverse dired-subdir-alist))))
2123 ;; top level directory may contain wildcards:
2124 (let ((dired-internal-switches switches))
2125 (dired-readin-insert dired-directory
2126 (null (file-directory-p dired-directory))))
2127 (let ((switches (dired-make-switches-string switches))
2128 (insert-directory-program dired-ls-program))
2129 (if (consp dir-or-list)
2130 (progn
2131 (insert "list wildcard\n")
2132 (mapcar
2133 (function
2134 (lambda (x)
2135 (insert-directory x switches t)))
2136 (cdr dir-or-list)))
2137 (insert-directory dirname switches nil t))))
2138 (message "Reading directory %s...done" dirname)
2139 (setq end (point-marker))
2140 (dired-indent-listing begin end)
2141 (dired-insert-set-properties begin end)
2142 ;; call dired-insert-headerline afterwards, as under VMS dired-ls
2143 ;; does insert the headerline itself and the insert function just
2144 ;; moves point.
2145 ;; Need a marker for END as this inserts text.
2146 (goto-char begin)
2147 (dired-insert-headerline dirname)
2148 ;; point is now like in dired-build-subdir-alist
2149 (prog1
2150 (list begin (marker-position end))
2151 (set-marker end nil))))
2152
2153 (defun dired-insert-subdir-doupdate (dirname beg-end switches elt mark-alist)
2154 ;; Point is at the correct subdir alist position for ELT,
2155 ;; BEG-END is the subdir-region (as list of begin and end).
2156 ;; SWITCHES must be a non-nil list.
2157 (if (memq ?R switches)
2158 ;; This will remove ?R from switches on purpose.
2159 (let ((dired-internal-switches (delq ?R switches)))
2160 (dired-build-subdir-alist))
2161 (if elt
2162 (progn
2163 (set-marker (dired-get-subdir-min elt) (point-marker))
2164 (setcar (nthcdr 3 elt) switches)
2165 (if dired-verify-modtimes
2166 (dired-set-file-modtime dirname dired-subdir-alist)))
2167 (dired-alist-add dirname (point-marker) dired-omit-files switches)))
2168 (save-excursion
2169 (let ((begin (nth 0 beg-end))
2170 (end (nth 1 beg-end)))
2171 (goto-char begin)
2172 (save-restriction
2173 (narrow-to-region begin end)
2174 ;; hook may add or delete lines, but the subdir boundary
2175 ;; marker floats
2176 (run-hooks 'dired-after-readin-hook)
2177 (if mark-alist (dired-mark-remembered mark-alist))
2178 (dired-do-hide dired-kill-marker-char)
2179 (if (if elt (nth 2 elt) dired-omit-files)
2180 (dired-omit-expunge nil t))))))
2181
2182
2183 ;;;; --------------------------------------------------------------
2184 ;;;; Dired motion commands -- moving around in the dired buffer.
2185 ;;;; --------------------------------------------------------------
2186
2187 (defun dired-next-line (arg)
2188 "Move down lines then position at filename.
2189 Optional prefix ARG says how many lines to move; default is one line."
2190 (interactive "p")
2191 (condition-case err
2192 (next-line arg)
2193 (error
2194 (if (eobp)
2195 (error "End of buffer")
2196 (error "%s" err))))
2197 (dired-move-to-filename)
2198 (dired-update-mode-line))
2199
2200 (defun dired-previous-line (arg)
2201 "Move up lines then position at filename.
2202 Optional prefix ARG says how many lines to move; default is one line."
2203 (interactive "p")
2204 (previous-line arg)
2205 (dired-move-to-filename)
2206 (dired-update-mode-line))
2207
2208 (defun dired-scroll-up (arg)
2209 "Dired version of scroll up.
2210 Scroll text of current window upward ARG lines; or near full screen if no ARG.
2211 When calling from a program, supply a number as argument or nil."
2212 (interactive "P")
2213 (scroll-up arg)
2214 (dired-move-to-filename)
2215 (dired-update-mode-line))
2216
2217 (defun dired-scroll-down (arg)
2218 "Dired version of scroll-down.
2219 Scroll text of current window down ARG lines; or near full screen if no ARG.
2220 When calling from a program, supply a number as argument or nil."
2221 (interactive "P")
2222 (scroll-down arg)
2223 (dired-move-to-filename)
2224 (dired-update-mode-line))
2225
2226 (defun dired-beginning-of-buffer (arg)
2227 "Dired version of `beginning of buffer'."
2228 (interactive "P")
2229 (beginning-of-buffer arg)
2230 (dired-update-mode-line))
2231
2232 (defun dired-end-of-buffer (arg)
2233 "Dired version of `end-of-buffer'."
2234 (interactive "P")
2235 (end-of-buffer arg)
2236 (while (not (or (dired-move-to-filename) (dired-get-subdir) (bobp)))
2237 (forward-line -1))
2238 (dired-update-mode-line t))
2239
2240 (defun dired-next-dirline (arg &optional opoint)
2241 "Goto ARG'th next directory file line."
2242 (interactive "p")
2243 (if dired-re-dir
2244 (progn
2245 (dired-check-ls-l)
2246 (or opoint (setq opoint (point)))
2247 (if (if (> arg 0)
2248 (re-search-forward dired-re-dir nil t arg)
2249 (beginning-of-line)
2250 (re-search-backward dired-re-dir nil t (- arg)))
2251 (progn
2252 (dired-move-to-filename) ; user may type `i' or `f'
2253 (dired-update-mode-line))
2254 (goto-char opoint)
2255 (error "No more subdirectories")))))
2256
2257 (defun dired-prev-dirline (arg)
2258 "Goto ARG'th previous directory file line."
2259 (interactive "p")
2260 (dired-next-dirline (- arg)))
2261
2262 (defun dired-next-marked-file (arg &optional wrap opoint)
2263 "Move to the next marked file, wrapping around the end of the buffer."
2264 (interactive "p\np")
2265 (or opoint (setq opoint (point))) ; return to where interactively started
2266 (if (if (> arg 0)
2267 (re-search-forward dired-re-mark nil t arg)
2268 (beginning-of-line)
2269 (re-search-backward dired-re-mark nil t (- arg)))
2270 (dired-move-to-filename)
2271 (if (null wrap)
2272 (progn
2273 (goto-char opoint)
2274 (error "No next marked file"))
2275 (message "(Wraparound for next marked file)")
2276 (goto-char (if (> arg 0) (point-min) (point-max)))
2277 (dired-next-marked-file arg nil opoint)))
2278 (dired-update-mode-line))
2279
2280 (defun dired-prev-marked-file (arg &optional wrap)
2281 "Move to the previous marked file, wrapping around the end of the buffer."
2282 (interactive "p\np")
2283 (dired-next-marked-file (- arg) wrap)
2284 (dired-update-mode-line))
2285
2286 (defun dired-goto-file (file)
2287 "Goto file line of FILE in this dired buffer."
2288 ;; Return value of point on success, else nil.
2289 ;; FILE must be an absolute pathname.
2290 ;; Loses if FILE contains control chars like "\007" for which ls
2291 ;; either inserts "?" or "\\007" into the buffer, so we won't find
2292 ;; it in the buffer.
2293 (interactive
2294 (prog1 ; let push-mark display its message
2295 (list
2296 (let* ((dired-completer-buffer (current-buffer))
2297 (dired-completer-switches dired-internal-switches)
2298 (stack (reverse
2299 (mapcar (function
2300 (lambda (x)
2301 (dired-abbreviate-file-name (car x))))
2302 dired-subdir-alist)))
2303 (initial (car stack))
2304 (dired-goto-file-history (cdr stack))
2305 dired-completer-cache)
2306 (expand-file-name
2307 (dired-completing-read "Goto file: "
2308 'dired-goto-file-completer
2309 nil t initial 'dired-goto-file-history))))
2310 (push-mark)))
2311 (setq file (directory-file-name file)) ; does no harm if no directory
2312 (let (found case-fold-search)
2313 (save-excursion
2314 (if (dired-goto-subdir (or (file-name-directory file)
2315 (error "Need absolute pathname for %s"
2316 file)))
2317 (let* ((base (file-name-nondirectory file))
2318 ;; filenames are preceded by SPC, this makes
2319 ;; the search faster (e.g. for the filename "-"!).
2320 (search (concat " " (dired-make-filename-string base t)))
2321 (boundary (dired-subdir-max))
2322 fn)
2323 (while (and (not found) (search-forward search boundary 'move))
2324 ;; Match could have BASE just as initial substring or
2325 ;; or in permission bits or date or
2326 ;; not be a proper filename at all:
2327 (if (and (setq fn (dired-get-filename 'no-dir t))
2328 (string-equal fn base))
2329 ;; Must move to filename since an (actually
2330 ;; correct) match could have been elsewhere on the
2331 ;; line (e.g. "-" would match somewhere in the
2332 ;; permission bits).
2333 (setq found (dired-move-to-filename)))))))
2334 (and found
2335 ;; return value of point (i.e., FOUND):
2336 (prog1
2337 (goto-char found)
2338 (dired-update-mode-line)))))
2339
2340 ;;; Moving by subdirectories
2341
2342 (defun dired-up-directory (arg)
2343 "Move to the ARG'th (prefix arg) parent directory of current directory.
2344 Always stays within the current tree dired buffer. Will insert new
2345 subdirectories if necessary."
2346 (interactive "p")
2347 (if (< arg 0) (error "Can't go up a negative number of directories!"))
2348 (or (zerop arg)
2349 (let* ((dir (dired-current-directory))
2350 (n arg)
2351 (up dir))
2352 (while (> n 0)
2353 (setq up (file-name-directory (directory-file-name up))
2354 n (1- n)))
2355 (if (and (< (length up) (length dired-directory))
2356 (dired-in-this-tree dired-directory up))
2357 (if (or (memq 'create-top-dir dired-no-confirm)
2358 (y-or-n-p
2359 (format "Insert new top dir %s and rename buffer? "
2360 (dired-abbreviate-file-name up))))
2361 (let ((newname (let (buff)
2362 (unwind-protect
2363 (buffer-name
2364 (setq buff
2365 (create-file-buffer
2366 (directory-file-name up))))
2367 (kill-buffer buff))))
2368 (buffer-read-only nil))
2369 (push-mark)
2370 (widen)
2371 (goto-char (point-min))
2372 (insert-before-markers "\n")
2373 (forward-char -1)
2374 (dired-insert-subdir-doupdate
2375 up (dired-insert-subdir-doinsert up dired-internal-switches)
2376 dired-internal-switches nil nil)
2377 (dired-initial-position up)
2378 (rename-buffer newname)
2379 (dired-unadvertise default-directory)
2380 (setq default-directory up
2381 dired-directory up)
2382 (dired-advertise)))
2383 (dired-maybe-insert-subdir up)))))
2384
2385 (defun dired-down-directory ()
2386 "Go down in the dired tree.
2387 Moves to the first subdirectory of the current directory, which exists in
2388 the dired buffer. Does not take a prefix argument."
2389 ;; What would a prefix mean here?
2390 (interactive)
2391 (let ((dir (dired-current-directory)) ; has slash
2392 (rest (reverse dired-subdir-alist))
2393 pos elt)
2394 (while rest
2395 (setq elt (car rest))
2396 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
2397 (setq rest nil
2398 pos (dired-goto-subdir (car elt)))
2399 (setq rest (cdr rest))))
2400 (prog1
2401 (if pos
2402 (progn
2403 (push-mark)
2404 (goto-char pos))
2405 (error "At the bottom"))
2406 (dired-update-mode-line t))))
2407
2408 (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
2409 "Go to next subdirectory, regardless of level."
2410 ;; Use 0 arg to go to this directory's header line.
2411 ;; NO-SKIP prevents moving to end of header line, returning whatever
2412 ;; position was found in dired-subdir-alist.
2413 (interactive "p")
2414 (let ((this-dir (dired-current-directory))
2415 pos index)
2416 ;; nth with negative arg does not return nil but the first element
2417 (setq index (- (length dired-subdir-alist)
2418 (length (memq (assoc this-dir dired-subdir-alist)
2419 dired-subdir-alist))
2420 arg))
2421 (setq pos (if (>= index 0)
2422 (dired-get-subdir-min (nth index dired-subdir-alist))))
2423 (if pos
2424 (if no-skip
2425 (goto-char pos)
2426 (goto-char pos)
2427 (skip-chars-forward "^\r\n")
2428 (if (= (following-char) ?\r)
2429 (skip-chars-backward "." (- (point) 3)))
2430 (dired-update-mode-line t)
2431 (point))
2432 (if no-error-if-not-found
2433 nil ; return nil if not found
2434 (error "%s directory" (if (> arg 0) "Last" "First"))))))
2435
2436 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
2437 "Go to previous subdirectory, regardless of level.
2438 When called interactively and not on a subdir line, go to this subdir's line."
2439 (interactive
2440 (list (if current-prefix-arg
2441 (prefix-numeric-value current-prefix-arg)
2442 ;; if on subdir start already, don't stay there!
2443 (if (dired-get-subdir) 1 0))))
2444 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
2445
2446 (defun dired-goto-subdir (dir)
2447 "Goto end of header line of DIR in this dired buffer.
2448 Return value of point on success, otherwise return nil.
2449 The next char is either \\n, or \\r if DIR is hidden."
2450 (interactive
2451 (prog1 ; let push-mark display its message
2452 (list
2453 (let* ((table (mapcar
2454 (function
2455 (lambda (x)
2456 (list (dired-abbreviate-file-name
2457 (car x)))))
2458 dired-subdir-alist))
2459 (stack (reverse (mapcar 'car table)))
2460 (initial (car stack))
2461 (dired-goto-file-history (cdr stack)))
2462 (expand-file-name
2463 (dired-completing-read "Goto subdirectory " table nil t
2464 initial 'dired-goto-file-history))))
2465 (push-mark)))
2466 (setq dir (file-name-as-directory dir))
2467 (let ((elt (assoc dir dired-subdir-alist)))
2468 (and elt
2469 ;; need to make sure that we get where we're going.
2470 ;; beware: narrowing might be in effect
2471 (eq (goto-char (dired-get-subdir-min elt)) (point))
2472 (progn
2473 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
2474 ;; at either \n or looking-at ...\r after this function succeeds.
2475 (skip-chars-forward "^\r\n")
2476 (if (= (preceding-char) ?.)
2477 (skip-chars-backward "." (- (point) 3)))
2478 (if (interactive-p) (dired-update-mode-line))
2479 (point)))))
2480
2481 ;;; Internals for motion commands
2482
2483 (defun dired-update-mode-line (&optional force)
2484 "Updates the mode line in dired according to the position of the point.
2485 Normally this uses a cache of the boundaries of the current subdirectory,
2486 but if the optional argument FORCE is non-nil, then modeline is always
2487 updated and the cache is recomputed."
2488 (if (or force
2489 (>= (point) dired-curr-subdir-max)
2490 (< (point) dired-curr-subdir-min))
2491 (let ((alist dired-subdir-alist)
2492 min max)
2493 (while (and alist (< (point)
2494 (setq min (dired-get-subdir-min (car alist)))))
2495 (setq alist (cdr alist)
2496 max min))
2497 (setq dired-curr-subdir-max (or max (point-max-marker))
2498 dired-curr-subdir-min (or min (point-min-marker))
2499 dired-subdir-omit (nth 2 (car alist)))
2500 (dired-sort-set-modeline (nth 3 (car alist))))))
2501
2502 (defun dired-manual-move-to-filename (&optional raise-error bol eol)
2503 "In dired, move to first char of filename on this line.
2504 Returns position (point) or nil if no filename on this line."
2505 ;; This is the UNIX version.
2506 ;; have to be careful that we don't move to omitted files
2507 (let (case-fold-search)
2508
2509 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
2510 (or bol (setq bol (progn (skip-chars-backward "^\r\n") (point))))
2511
2512 (if (or (memq ?l dired-internal-switches)
2513 (memq ?g dired-internal-switches))
2514 (if (and
2515 (> (- eol bol) 17) ; a valid file line must have at least
2516 ; 17 chars. 2 leading, 10 perms,
2517 ; separator, node #, separator, owner,
2518 ; separator
2519 (goto-char (+ bol 17))
2520 (re-search-forward dired-re-month-and-time eol t))
2521 (point)
2522 (goto-char bol)
2523 (if raise-error
2524 (error "No file on this line")
2525 nil))
2526 ;; else ls switches don't contain -l.
2527 ;; Note that even if we make dired-move-to-filename and
2528 ;; dired-move-to-end-of-filename (and thus dired-get-filename)
2529 ;; work, all commands that gleaned information from the permission
2530 ;; bits (like dired-mark-directories) will cease to work properly.
2531 (if (= bol eol)
2532 (if raise-error
2533 (error "No file on this line")
2534 nil)
2535 ;; skip marker, if any
2536 (goto-char bol)
2537 (forward-char))
2538 ;; If we not going to use the l switch, and use nstd listings,
2539 ;; then we must bomb on files starting with spaces.
2540 (skip-chars-forward " \t")
2541 (point))))
2542
2543 (defun dired-manual-move-to-end-of-filename (&optional no-error bol eol)
2544 ;; Assumes point is at beginning of filename,
2545 ;; thus the rwx bit re-search-backward below will succeed in *this*
2546 ;; line if at all. So, it should be called only after
2547 ;; (dired-move-to-filename t).
2548 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
2549 ;; This is the UNIX version.
2550 (let ((bof (point))
2551 file-type modes-start case-fold-search)
2552 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
2553 (or bol (setq bol (save-excursion (skip-chars-backward "^\r\n") (point))))
2554 (and
2555 (null no-error)
2556 selective-display
2557 (eq (char-after (1- bol)) ?\r)
2558 (cond
2559 ((dired-subdir-hidden-p (dired-current-directory))
2560 (error
2561 (substitute-command-keys
2562 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
2563 ((error
2564 (substitute-command-keys
2565 "File line is omitted. Type \\[dired-omit-toggle] to un-omit.")))))
2566 (if (or (memq ?l dired-internal-switches)
2567 (memq ?g dired-internal-switches))
2568 (if (save-excursion
2569 (goto-char bol)
2570 (re-search-forward
2571 "[^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ][-+ 0-9+]"
2572 bof t))
2573 (progn
2574 (setq modes-start (match-beginning 0)
2575 file-type (char-after modes-start))
2576 ;; Move point to end of name:
2577 (if (eq file-type ?l) ; symlink
2578 (progn
2579 (if (search-forward " -> " eol t)
2580 (goto-char (match-beginning 0))
2581 (goto-char eol))
2582 (and dired-ls-F-marks-symlinks
2583 (eq (preceding-char) ?@) ; link really marked?
2584 (memq ?F dired-internal-switches)
2585 (forward-char -1))
2586 (point))
2587 ;; else not a symbolic link
2588 (goto-char eol)
2589 ;; ls -lF marks dirs, sockets and executables with exactly
2590 ;; one trailing character. -F may not actually be honored,
2591 ;; e.g. by an FTP ls in efs
2592 (and
2593 (memq ?F dired-internal-switches)
2594 (let ((char (preceding-char)))
2595 (or (and (eq char ?*) (or
2596 (memq
2597 (char-after (+ modes-start 3))
2598 '(?x ?s ?t))
2599 (memq
2600 (char-after (+ modes-start 6))
2601 '(?x ?s ?t))
2602 (memq
2603 (char-after (+ modes-start 9))
2604 '(?x ?s ?t))))
2605 (and (eq char ?=) (eq file-type ?s))))
2606 (forward-char -1))
2607 ;; Skip back over /'s unconditionally. It's not a valid
2608 ;; file name character.
2609 (skip-chars-backward "/")
2610 (point)))
2611 (and (null no-error)
2612 (error "No file on this line")))
2613
2614 ;; A brief listing
2615 (if (eq (point) eol)
2616 (and (null no-error)
2617 (error "No file on this line"))
2618 (goto-char eol)
2619 (if (and (memq (preceding-char) '(?@ ?* ?=))
2620 (memq ?F dired-internal-switches))
2621 ;; A guess, since without a long listing, we can't be sure.
2622 (forward-char -1))
2623 (skip-chars-backward "/")
2624 (point)))))
2625
2626 (defun dired-goto-next-nontrivial-file ()
2627 ;; Position point on first nontrivial file after point.
2628 ;; Does not move into the next sudir.
2629 ;; If point is on a file line, moves to that file.
2630 ;; This does not move to omitted files.
2631 (skip-chars-backward "^\n\r")
2632 (if (= (preceding-char) ?\r)
2633 (forward-line 1))
2634 (let ((max (dired-subdir-max))
2635 file)
2636 (while (and (or (not (setq file (dired-get-filename 'no-dir t)))
2637 (string-match dired-trivial-filenames file))
2638 (< (point) max))
2639 (forward-line 1)))
2640 (dired-move-to-filename))
2641
2642 (defun dired-goto-next-file ()
2643 ;; Doesn't move out of current subdir. Does go to omitted files.
2644 ;; Returns the starting position of the file, or nil if none found.
2645 (let ((max (dired-subdir-max))
2646 found)
2647 (while (and (null (setq found (dired-move-to-filename))) (< (point) max))
2648 (skip-chars-forward "^\n\r")
2649 (forward-char 1))
2650 found))
2651
2652 ;; fluid vars used by dired-goto-file-completer
2653 (defvar dired-completer-buffer nil)
2654 (defvar dired-completer-switches nil)
2655 (defvar dired-completer-cache nil)
2656
2657 (defun dired-goto-file-completer (string pred action)
2658 (save-excursion
2659 (set-buffer dired-completer-buffer)
2660 (let* ((saved-md (match-data))
2661 (file (file-name-nondirectory string))
2662 (dir (file-name-directory string))
2663 (xstring (expand-file-name string))
2664 (xdir (file-name-directory xstring))
2665 (exact (dired-goto-file xstring)))
2666 (unwind-protect
2667 (if (dired-goto-subdir xdir)
2668 (let ((table (cdr (assoc xdir dired-completer-cache)))
2669 fn result max)
2670 (or table
2671 (progn
2672 (setq table (make-vector 37 0))
2673 (mapcar (function
2674 (lambda (ent)
2675 (setq ent (directory-file-name
2676 (car ent)))
2677 (if (string-equal
2678 (file-name-directory ent) xdir)
2679 (intern
2680 (concat
2681 (file-name-nondirectory ent) "/")
2682 table))))
2683 dired-subdir-alist)
2684 (or (looking-at "\\.\\.\\.\n\r")
2685 (progn
2686 (setq max (dired-subdir-max))
2687 (while (and
2688 (< (point) max)
2689 (not
2690 (setq fn
2691 (dired-get-filename 'no-dir t))))
2692 (forward-line 1))
2693 (if fn
2694 (progn
2695 (or (intern-soft (concat fn "/") table)
2696 (intern fn table))
2697 (forward-line 1)
2698 (while (setq fn
2699 (dired-get-filename 'no-dir t))
2700 (or (intern-soft (concat fn "/") table)
2701 (intern fn table))
2702 (forward-line 1))))))
2703 (setq dired-completer-cache (cons
2704 (cons xdir table)
2705 dired-completer-cache))))
2706 (cond
2707 ((null action)
2708 (setq result (try-completion file table))
2709 (if exact
2710 (if (stringp result)
2711 string
2712 t)
2713 (if (stringp result)
2714 (concat dir result)
2715 result)))
2716 ((eq action t)
2717 (setq result (all-completions file table))
2718 (if exact (cons "." result) result))
2719 ((eq 'lambda action)
2720 (and (or exact (intern-soft file table)))))))
2721 (store-match-data saved-md)))))
2722
2723 (defun dired-really-goto-file (file)
2724 ;; Goes to a file, even if it needs to insert it parent directory.
2725 (or (dired-goto-file file)
2726 (progn ; refresh and try again
2727 (dired-insert-subdir (file-name-directory file))
2728 (dired-goto-file file))))
2729
2730 (defun dired-between-files ()
2731 ;; Point must be at beginning of line
2732 (save-excursion (not (dired-move-to-filename nil (point)))))
2733
2734 (defun dired-repeat-over-lines (arg function)
2735 ;; This version skips non-file lines.
2736 ;; Skips file lines hidden with selective display.
2737 ;; BACKWARDS means move backwards after each action. This is not the same
2738 ;; as a negative arg, as that skips the current line.
2739 (beginning-of-line)
2740 (let* ((advance (cond ((> arg 0) 1) ((< arg 0) -1) (t nil)))
2741 (check-fun (if (eq advance 1) 'eobp 'bobp))
2742 (n (if (< arg 0) (- arg) arg))
2743 (wall (funcall check-fun))
2744 (done wall))
2745 (while (not done)
2746 (if advance
2747 (progn
2748 (while (not (or (save-excursion (dired-move-to-filename))
2749 (setq wall (funcall check-fun))))
2750 (forward-line advance))
2751 (or wall
2752 (progn
2753 (save-excursion (funcall function))
2754 (forward-line advance)
2755 (while (not (or (save-excursion (dired-move-to-filename))
2756 (setq wall (funcall check-fun))))
2757 (forward-line advance))
2758 (setq done (or (zerop (setq n (1- n))) wall)))))
2759 (if (save-excursion (dired-move-to-filename))
2760 (save-excursion (funcall function)))
2761 (setq done t))))
2762 (dired-move-to-filename)
2763 ;; Note that if possible the point has now been moved to the beginning of
2764 ;; the file name.
2765 (dired-update-mode-line))
2766
2767
2768 ;;;; ----------------------------------------------------------------
2769 ;;;; Miscellaneous dired commands
2770 ;;;; ----------------------------------------------------------------
2771
2772 (defun dired-quit ()
2773 "Bury the current dired buffer."
2774 (interactive)
2775 (bury-buffer))
2776
2777 (defun dired-undo ()
2778 "Undo in a dired buffer.
2779 This doesn't recover lost files, it is just normal undo with temporarily
2780 writeable buffer. You can use it to recover marks, killed lines or subdirs."
2781 (interactive)
2782 (let ((lines (count-lines (point-min) (point-max)))
2783 buffer-read-only)
2784 (undo)
2785 ;; reset dired-subdir-alist, if a dir may have been affected
2786 ;; Is there a better way to guess this?
2787 (setq lines (- (count-lines (point-min) (point-max)) lines))
2788 (if (or (>= lines 2) (<= lines -2))
2789 (dired-build-subdir-alist)))
2790 (dired-update-mode-line-modified t)
2791 (dired-update-mode-line t))
2792
2793
2794 ;;;; --------------------------------------------------------
2795 ;;;; Immediate actions on files: visiting, viewing, etc.
2796 ;;;; --------------------------------------------------------
2797
2798 (defun dired-find-file ()
2799 "In dired, visit the file or directory named on this line."
2800 (interactive)
2801 (find-file (dired-get-filename)))
2802
2803 (defun dired-view-file ()
2804 "In dired, examine a file in view mode, returning to dired when done.
2805 When file is a directory, show it in this buffer if it is inserted;
2806 otherwise, display it in another buffer."
2807 (interactive)
2808 (let ((file (dired-get-filename)))
2809 (if (file-directory-p file)
2810 (or (dired-goto-subdir file)
2811 (dired file))
2812 (view-file file))))
2813
2814 (defun dired-find-file-other-window (&optional display)
2815 "In dired, visit this file or directory in another window.
2816 With a prefix, the file is displayed, but the window is not selected."
2817 (interactive "P")
2818 (if display
2819 (dired-display-file)
2820 (find-file-other-window (dired-get-filename))))
2821
2822 ;; Only for Emacs 19
2823 (defun dired-find-file-other-frame ()
2824 "In dired, visit this file or directory in another frame."
2825 (interactive)
2826 (find-file-other-frame (dired-get-filename)))
2827
2828 (defun dired-display-file ()
2829 "In dired, displays this file or directory in the other window."
2830 (interactive)
2831 (display-buffer (find-file-noselect (dired-get-filename))))
2832
2833 ;; After an idea by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
2834 (defun dired-do-find-file (&optional arg)
2835 "Visit all marked files at once, and display them simultaneously.
2836 See also function `simultaneous-find-file'.
2837 If you want to keep the dired buffer displayed, type \\[split-window-vertically] first.
2838 If you want just the marked files displayed and nothing else, type \\[delete-other-windows] first."
2839 (interactive "P")
2840 (dired-simultaneous-find-file (dired-get-marked-files nil arg)))
2841
2842 (defun dired-simultaneous-find-file (file-list)
2843 "Visit all files in FILE-LIST and display them simultaneously.
2844
2845 The current window is split across all files in FILE-LIST, as evenly
2846 as possible. Remaining lines go to the bottommost window.
2847
2848 The number of files that can be displayed this way is restricted by
2849 the height of the current window and the variable `window-min-height'."
2850 ;; It is usually too clumsy to specify FILE-LIST interactively
2851 ;; unless via dired (dired-do-find-file).
2852 (let ((size (/ (window-height) (length file-list))))
2853 (or (<= window-min-height size)
2854 (error "Too many files to visit simultaneously"))
2855 (find-file (car file-list))
2856 (setq file-list (cdr file-list))
2857 (while file-list
2858 ;; Split off vertically a window of the desired size
2859 ;; The upper window will have SIZE lines. We select the lower
2860 ;; (larger) window because we want to split that again.
2861 (select-window (split-window nil size))
2862 (find-file (car file-list))
2863 (setq file-list (cdr file-list)))))
2864
2865 (defun dired-create-directory (directory)
2866 "Create a directory called DIRECTORY."
2867 (interactive
2868 (list (read-file-name "Create directory: "
2869 (dired-abbreviate-file-name
2870 (dired-current-directory)))))
2871 (let ((expanded (expand-file-name directory)))
2872 (make-directory expanded)
2873 ;; Because this function is meant to be called interactively, it moves
2874 ;; the point.
2875 (dired-goto-file expanded)))
2876
2877 (defun dired-recover-file ()
2878 "Recovers file from its autosave file.
2879 If the file is an autosave file, then recovers its associated file instead."
2880 (interactive)
2881 (let* ((file (dired-get-filename))
2882 (name (file-name-nondirectory file))
2883 (asp (auto-save-file-name-p name))
2884 (orig (and
2885 asp
2886 (if (fboundp 'auto-save-original-name)
2887 (auto-save-original-name file)
2888 (error
2889 "Need auto-save package to compute original file name."))))
2890 (buff (if asp
2891 (and orig (get-file-buffer orig))
2892 (get-file-buffer file))))
2893 (and
2894 buff
2895 (buffer-modified-p buff)
2896 (or
2897 (yes-or-no-p
2898 (format
2899 "Recover file will erase the modified buffer %s. Do it? "
2900 (buffer-name buff)))
2901 (error "Recover file aborted.")))
2902 (if asp
2903 (if orig
2904 (recover-file orig)
2905 (find-file file))
2906 (recover-file file))))
2907
2908
2909 ;;;; --------------------------------------------------------------------
2910 ;;;; Functions for extracting and manipulating file names
2911 ;;;; --------------------------------------------------------------------
2912
2913 (defun dired-make-filename-string (filename &optional reverse)
2914 ;; Translates the way that a file name appears in a buffer, to
2915 ;; how it is used in a path name. This is useful for non-unix
2916 ;; support in efs.
2917 filename)
2918
2919 (defun dired-get-filename (&optional localp no-error-if-not-filep)
2920 "In dired, return name of file mentioned on this line.
2921 Value returned normally includes the directory name.
2922 Optional arg LOCALP with value `no-dir' means don't include directory
2923 name in result. A value of t means use path name relative to
2924 `default-directory', which still may contain slashes if in a subdirectory.
2925 Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
2926 this line, otherwise an error occurs."
2927
2928 ;; Compute bol & eol once, rather than twice inside move-to-filename
2929 ;; and move-to-end-of-filename
2930 (let ((eol (save-excursion (skip-chars-forward "^\n\r") (point)))
2931 (bol (save-excursion (skip-chars-backward "^\r\n") (point)))
2932 case-fold-search file p1 p2)
2933 (save-excursion
2934 (and
2935 (setq p1 (dired-move-to-filename (not no-error-if-not-filep) bol eol))
2936 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep bol eol))
2937 (setq file (buffer-substring p1 p2))
2938 ;; Check if ls quoted the names, and unquote them.
2939 ;; Using read to unquote is much faster than substituting
2940 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
2941 (cond ((memq ?b dired-internal-switches) ; System V ls
2942 ;; This case is about 20% slower than without -b.
2943 (setq file
2944 (read
2945 (concat "\""
2946 ;; some ls -b don't escape quotes, argh!
2947 ;; This is not needed for GNU ls, though.
2948 (or (dired-string-replace-match
2949 "\\([^\\]\\)\"" file "\\1\\\\\"")
2950 file)
2951 "\""))))
2952 ;; If you do this, update dired-compatible-switches-p
2953 ;; ((memq ?Q dired-internal-switches) ; GNU ls
2954 ;; (setq file (read file)))
2955 )))
2956 (and file
2957 (if (eq localp 'no-dir)
2958 (dired-make-filename-string file)
2959 (concat (dired-current-directory localp)
2960 (dired-make-filename-string file))))))
2961
2962 (defun dired-make-relative (file &optional dir no-error)
2963 ;; Convert FILE (an *absolute* pathname) to a pathname relative to DIR.
2964 ;; FILE must be absolute, or this function will return nonsense.
2965 ;; If FILE is not in a subdir of DIR, an error is signalled,
2966 ;; unless NO-ERROR is t. Then, ".."'s are inserted to give
2967 ;; a relative representation of FILE wrto DIR
2968 ;; eg. FILE = /vol/tex/bin/foo DIR = /vol/local/bin/
2969 ;; results in ../../tex/bin/foo
2970 ;; DIR must be expanded.
2971 ;; DIR defaults to default-directory.
2972 ;; DIR must be file-name-as-directory, as with all directory args in
2973 ;; elisp code.
2974 (or dir (setq dir (expand-file-name default-directory)))
2975 (let ((flen (length file))
2976 (dlen (length dir)))
2977 (if (and (> flen dlen)
2978 (string-equal (substring file 0 dlen) dir))
2979 (substring file dlen)
2980 ;; Need to insert ..'s
2981 (or no-error (error "%s: not in directory tree growing at %s" file dir))
2982 (if (string-equal file dir)
2983 "./"
2984 (let ((index 1)
2985 (count 0))
2986 (while (and (string-match "/" dir index)
2987 (<= (match-end 0) flen)
2988 (string-equal (substring file index (match-end 0))
2989 (substring dir index (match-end 0))))
2990 (setq index (match-end 0)))
2991 (setq file (substring file index))
2992 (if (and (/= flen index)
2993 (not (string-match "/" file))
2994 (< flen dlen)
2995 (string-equal file (substring dir index flen))
2996 (= (aref dir flen) ?/))
2997 (setq file "."
2998 count -1))
2999 ;; count how many slashes remain in dir.
3000 (while (string-match "/" dir index)
3001 (setq index (match-end 0)
3002 count (1+ count)))
3003 (apply 'concat (nconc (make-list count "../") (list file))))))))
3004
3005 ;;; Functions for manipulating file names.
3006 ;;
3007 ;; Used by file tranformers.
3008 ;; Define here rather than in dired-shell.el, as it wouldn't be
3009 ;; unreasonable to use these elsewhere.
3010
3011 (defun dired-file-name-base (fn)
3012 "Returns the base name of FN.
3013 This is the file without directory part, and extension. See the variable
3014 `dired-filename-re-ext'."
3015 (setq fn (file-name-nondirectory fn))
3016 (if (string-match dired-filename-re-ext fn 1)
3017 (substring fn 0 (match-beginning 0))
3018 fn))
3019
3020 (defun dired-file-name-extension (fn)
3021 "Returns the extension for file name FN.
3022 See the variable dired-filename-re-ext'."
3023 (setq fn (file-name-nondirectory fn))
3024 (if (string-match dired-filename-re-ext fn 1)
3025 (substring fn (match-beginning 0))
3026 ""))
3027
3028 (defun dired-file-name-sans-rcs-extension (fn)
3029 "Returns the file name FN without its RCS extension \",v\"."
3030 (setq fn (file-name-nondirectory fn))
3031 (if (string-match ",v$" fn 1)
3032 (substring fn 0 (match-beginning 0))
3033 fn))
3034
3035 (defun dired-file-name-sans-compress-extension (fn)
3036 "Returns the file name FN without the extension from compress or gzip."
3037 (setq fn (file-name-nondirectory fn))
3038 (if (string-match "\\.\\([zZ]\\|gz\\)$" fn 1)
3039 (substring fn (match-beginning 0))
3040 fn))
3041
3042
3043 ;;;; ---------------------------------------------------------------------
3044 ;;;; Working with directory trees.
3045 ;;;; ---------------------------------------------------------------------
3046 ;;;
3047 ;;; This where code for the dired-subdir-alist is.
3048
3049 ;;; Utility functions for dired-subdir-alist
3050
3051 (defun dired-normalize-subdir (dir)
3052 ;; Prepend default-directory to DIR if relative path name.
3053 ;; dired-get-filename must be able to make a valid filename from a
3054 ;; file and its directory DIR.
3055 ;; Fully expand everything.
3056 (file-name-as-directory
3057 (if (file-name-absolute-p dir)
3058 (expand-file-name dir)
3059 (expand-file-name dir (expand-file-name default-directory)))))
3060
3061 (defun dired-get-subdir ()
3062 ;;"Return the subdir name on this line, or nil if not on a headerline."
3063 ;; Look up in the alist whether this is a headerline.
3064 (save-excursion
3065 (let ((cur-dir (dired-current-directory)))
3066 (beginning-of-line) ; alist stores b-o-l positions
3067 (and (zerop (- (point)
3068 (dired-get-subdir-min (assoc cur-dir
3069 dired-subdir-alist))))
3070 cur-dir))))
3071
3072 (defun dired-get-subdir-max (elt)
3073 ;; returns subdir max.
3074 (let ((pos (- (length dired-subdir-alist)
3075 (length (member elt dired-subdir-alist)))))
3076 (if (zerop pos)
3077 (point-max)
3078 (1- (dired-get-subdir-min (nth (1- pos) dired-subdir-alist))))))
3079
3080 (defun dired-clear-alist ()
3081 ;; Set all markers in dired-subdir-alist to nil. Set the alist to nil too.
3082 (while dired-subdir-alist
3083 (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
3084 (setq dired-subdir-alist (cdr dired-subdir-alist))))
3085
3086 (defun dired-unsubdir (dir)
3087 ;; Remove DIR from the alist
3088 (setq dired-subdir-alist
3089 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
3090
3091 (defun dired-simple-subdir-alist ()
3092 ;; Build and return `dired-subdir-alist' assuming just the top level
3093 ;; directory to be inserted. Don't parse the buffer.
3094 (setq dired-subdir-alist
3095 (list (list (expand-file-name default-directory)
3096 (point-min-marker) dired-omit-files
3097 dired-internal-switches nil)))
3098 (if dired-verify-modtimes
3099 (dired-set-file-modtime (expand-file-name default-directory)
3100 dired-subdir-alist)))
3101
3102 (defun dired-build-subdir-alist ()
3103 "Build `dired-subdir-alist' by parsing the buffer and return its new value."
3104 (interactive)
3105 (let ((o-alist dired-subdir-alist)
3106 (count 0)
3107 subdir)
3108 (dired-clear-alist)
3109 (save-excursion
3110 (goto-char (point-min))
3111 (while (re-search-forward dired-subdir-regexp nil t)
3112 (setq count (1+ count))
3113 (apply 'dired-alist-add-1
3114 (setq subdir (buffer-substring (match-beginning 2)
3115 (match-end 2)))
3116 ;; Put subdir boundary between lines.
3117 (set-marker (make-marker) (match-end 1))
3118 (let ((elt (assoc subdir o-alist)))
3119 (if elt
3120 (list (nth 2 elt) (nth 3 elt))
3121 (list dired-omit-files dired-internal-switches)))))
3122 (if (interactive-p)
3123 (message "%d director%s." count (if (= 1 count) "y" "ies")))
3124 ;; We don't need to sort it because it is in buffer order per
3125 ;; constructionem. Return new alist:
3126 ;; pointers for current-subdir may be stale
3127 dired-subdir-alist)))
3128
3129 (defun dired-alist-add (dir new-marker &optional omit switches)
3130 ;; Add new DIR at NEW-MARKER. Sort alist.
3131 (dired-alist-add-1 dir new-marker omit switches)
3132 (dired-alist-sort))
3133
3134 (defun dired-alist-add-1 (dir new-marker &optional omit switches)
3135 ;; Add new DIR at NEW-MARKER. Don't sort.
3136 (let ((dir (dired-normalize-subdir dir)))
3137 (setq dired-subdir-alist
3138 (cons (list dir new-marker omit switches nil) dired-subdir-alist))
3139 (if dired-verify-modtimes
3140 (dired-set-file-modtime dir dired-subdir-alist))))
3141
3142 (defun dired-alist-sort ()
3143 ;; Keep the alist sorted on buffer position.
3144 (setq dired-subdir-alist
3145 (sort dired-subdir-alist
3146 (function (lambda (elt1 elt2)
3147 (> (dired-get-subdir-min elt1)
3148 (dired-get-subdir-min elt2)))))))
3149
3150 ;;; Utilities for working with subdirs in the dired buffer
3151
3152 ;; This function is the heart of tree dired.
3153 ;; It is called for each retrieved filename.
3154 ;; It could stand to be faster, though it's mostly function call
3155 ;; overhead. Avoiding to funcall seems to save about 10% in
3156 ;; dired-get-filename. Make it a defsubst?
3157 (defun dired-current-directory (&optional localp)
3158 "Return the name of the subdirectory to which this line belongs.
3159 This returns a string with trailing slash, like `default-directory'.
3160 Optional argument means return a file name relative to `default-directory'.
3161 In this it returns \"\" for the top directory."
3162 (let* ((here (point))
3163 (dir (catch 'done
3164 (mapcar (function
3165 (lambda (x)
3166 (if (<= (dired-get-subdir-min x) here)
3167 (throw 'done (car x)))))
3168 dired-subdir-alist))))
3169 (if (listp dir) (error "dired-subdir-alist seems to be mangled"))
3170 (if localp
3171 (let ((def-dir (expand-file-name default-directory)))
3172 (if (string-equal dir def-dir)
3173 ""
3174 (dired-make-relative dir def-dir)))
3175 dir)))
3176
3177 ;; Subdirs start at the beginning of their header lines and end just
3178 ;; before the beginning of the next header line (or end of buffer).
3179
3180 (defun dired-subdir-min ()
3181 ;; Returns the minimum position of the current subdir
3182 (save-excursion
3183 (if (not (dired-prev-subdir 0 t t))
3184 (error "Not in a subdir!")
3185 (point))))
3186
3187 (defun dired-subdir-max ()
3188 ;; Returns the maximum position of the current subdir
3189 (save-excursion
3190 (if (dired-next-subdir 1 t t)
3191 (1- (point)) ; Do not include separating empty line.
3192 (point-max))))
3193
3194
3195 ;;;; --------------------------------------------------------
3196 ;;;; Deleting files
3197 ;;;; --------------------------------------------------------
3198
3199 (defun dired-flag-file-deletion (arg)
3200 "In dired, flag the current line's file for deletion.
3201 With prefix arg, repeat over several lines.
3202
3203 If on a subdir headerline, mark all its files except `.' and `..'."
3204 (interactive "p")
3205 (dired-mark arg dired-del-marker))
3206
3207 (defun dired-flag-file-deletion-backup (arg)
3208 "Flag current file for deletion, and move to previous line.
3209 With a prefix ARG, repeats this ARG times."
3210 (interactive "p")
3211 ;; Use dired-mark-file and not dired-mark, as this function
3212 ;; should do nothing special on subdir headers.
3213 (dired-mark-file (- arg) dired-del-marker))
3214
3215 (defun dired-flag-subdir-files ()
3216 "Flag all the files in the current subdirectory for deletion."
3217 (interactive)
3218 (dired-mark-subdir-files dired-del-marker))
3219
3220 (defun dired-unflag (arg)
3221 "In dired, remove a deletion flag from the current line's file.
3222 Optional prefix ARG says how many lines to unflag."
3223 (interactive "p")
3224 (let (buffer-read-only)
3225 (dired-repeat-over-lines
3226 arg
3227 (function
3228 (lambda ()
3229 (if (char-equal (following-char) dired-del-marker)
3230 (progn
3231 (setq dired-del-flags-number (max (1- dired-del-flags-number) 0))
3232 (dired-substitute-marker (point) dired-del-marker ?\ )))))))
3233 (dired-update-mode-line-modified))
3234
3235 (defun dired-backup-unflag (arg)
3236 "In dired, move up lines and remove deletion flag there.
3237 Optional prefix ARG says how many lines to unflag; default is one line."
3238 (interactive "p")
3239 (dired-unflag (- arg)))
3240
3241 (defun dired-update-marker-counters (char &optional remove)
3242 (or (memq char '(?\ ?\n ?\r))
3243 (let ((counter (cond
3244 ((char-equal char dired-del-marker)
3245 'dired-del-flags-number)
3246 ((char-equal char dired-marker-char)
3247 'dired-marks-number)
3248 ('dired-other-marks-number))))
3249 (if remove
3250 (set counter (max (1- (symbol-value counter)) 0))
3251 (set counter (1+ (symbol-value counter)))))))
3252
3253 (defun dired-update-mode-line-modified (&optional check)
3254 ;; Updates the value of mode-line-modified in dired.
3255 ;; Currently assumes that it's of the form "-%%-", where % sometimes
3256 ;; gets replaced by %. Should allow some sort of config flag.
3257 ;; SET is t to set to -DD-, nil to set to -%%-, and 'check means
3258 ;; examine the buffer to find out.
3259 (if check
3260 (save-excursion
3261 (let (char)
3262 (goto-char (point-min))
3263 (setq dired-del-flags-number 0
3264 dired-marks-number 0
3265 dired-other-marks-number 0)
3266 (while (not (eobp))
3267 (setq char (following-char))
3268 (cond
3269 ((char-equal char dired-del-marker)
3270 (setq dired-del-flags-number (1+ dired-del-flags-number)))
3271 ((char-equal char dired-marker-char)
3272 (setq dired-marks-number (1+ dired-marks-number)))
3273 ((memq char '(?\ ?\n ?\r))
3274 nil)
3275 ((setq dired-other-marks-number (1+ dired-other-marks-number))))
3276 (forward-line 1)))))
3277 (setq mode-line-modified
3278 (format dired-mode-line-modified
3279 (if (zerop dired-del-flags-number)
3280 "--"
3281 (format "%d%c" dired-del-flags-number dired-del-marker))
3282 (if (zerop dired-marks-number)
3283 "--"
3284 (format "%d%c" dired-marks-number dired-marker-char))
3285 (if (zerop dired-other-marks-number)
3286 "-"
3287 (int-to-string dired-other-marks-number))))
3288 (set-buffer-modified-p (buffer-modified-p)))
3289
3290 (defun dired-do-deletions (&optional nomessage)
3291 (dired-expunge-deletions))
3292
3293 (defun dired-expunge-deletions ()
3294 "In dired, delete the files flagged for deletion."
3295 (interactive)
3296 (let ((files (let ((dired-marker-char dired-del-marker))
3297 (dired-map-over-marks (cons (dired-get-filename) (point))
3298 t))))
3299 (if files
3300 (progn
3301 (dired-internal-do-deletions files nil dired-del-marker)
3302 ;; In case the point gets left somewhere strange -- hope that
3303 ;; this doesn't cause asynch troubles later.
3304 (beginning-of-line)
3305 (dired-goto-next-nontrivial-file)
3306 (dired-update-mode-line-modified t)) ; play safe, it's cheap
3307 (message "(No deletions requested)"))))
3308
3309 (defun dired-do-delete (&optional arg)
3310 "Delete all marked (or next ARG) files."
3311 ;; This is more consistent with the file marking feature than
3312 ;; dired-expunge-deletions.
3313 (interactive "P")
3314 (dired-internal-do-deletions
3315 ;; this may move point if ARG is an integer
3316 (dired-map-over-marks (cons (dired-get-filename) (point))
3317 arg)
3318 arg)
3319 (beginning-of-line)
3320 (dired-goto-next-nontrivial-file))
3321
3322 (defun dired-internal-do-deletions (l arg &optional marker-char)
3323 ;; L is an alist of files to delete, with their buffer positions.
3324 ;; ARG is the prefix arg.
3325 ;; Filenames are absolute (VMS needs this for logical search paths).
3326 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
3327 ;; That way as changes are made in the buffer they do not shift the
3328 ;; lines still to be changed, so the (point) values in L stay valid.
3329 ;; Also, for subdirs in natural order, a subdir's files are deleted
3330 ;; before the subdir itself - the other way around would not work.
3331 (save-excursion
3332 (let ((files (mapcar (function car) l))
3333 (count (length l))
3334 (succ 0)
3335 (cdir (dired-current-directory))
3336 failures)
3337 ;; canonicalize file list for pop up
3338 (setq files (nreverse (mapcar (function
3339 (lambda (fn)
3340 (dired-make-relative fn cdir t)))
3341 files)))
3342 (if (or (memq 'delete dired-no-confirm)
3343 (dired-mark-pop-up
3344 " *Files Flagged for Deletion*" 'delete files
3345 dired-deletion-confirmer
3346 (format "Delete %s "
3347 (dired-mark-prompt arg files marker-char))))
3348 (save-excursion
3349 ;; files better be in reverse order for this loop!
3350 (while l
3351 (goto-char (cdr (car l)))
3352 (condition-case err
3353 (let ((fn (car (car l))))
3354 ;; This test is equivalent to
3355 ;; (and (file-directory-p fn)
3356 ;; (not (file-symlink-p fn)))
3357 ;; but more efficient
3358 (if (if (eq t (car (file-attributes fn)))
3359 (if (<= (length (directory-files fn)) 2)
3360 (progn (delete-directory fn) t)
3361 (and (or
3362 (memq 'recursive-delete dired-no-confirm)
3363 (funcall
3364 dired-deletion-confirmer
3365 (format "\
3366 Recursively delete directory and files within %s? "
3367 (dired-make-relative fn))))
3368 (progn
3369 (dired-recursive-delete-directory fn)
3370 t)))
3371 (progn (delete-file fn) t))
3372 (progn
3373 (setq succ (1+ succ))
3374 (message "%s of %s deletions" succ count)
3375 (dired-clean-up-after-deletion fn))))
3376 (error;; catch errors from failed deletions
3377 (dired-log (buffer-name (current-buffer)) "%s\n" err)
3378 (setq failures (cons (car (car l)) failures))))
3379 (setq l (cdr l)))))
3380 (if failures
3381 (dired-log-summary
3382 (buffer-name (current-buffer))
3383 (format "%d of %d deletion%s failed:" (length failures) count
3384 (dired-plural-s count))
3385 failures)
3386 (if (zerop succ)
3387 (message "(No deletions performed)")
3388 (message "%d deletion%s done" succ (dired-plural-s succ)))))))
3389
3390 (defun dired-recursive-delete-directory (fn)
3391 ;; Recursively deletes directory FN, and all of its contents.
3392 (let* ((fn (expand-file-name fn))
3393 (handler (find-file-name-handler
3394 fn 'dired-recursive-delete-directory)))
3395 (if handler
3396 (funcall handler 'dired-recursive-delete-directory fn)
3397 (progn
3398 (or (file-exists-p fn)
3399 (signal
3400 'file-error
3401 (list "Removing old file name" "no such directory" fn)))
3402 ;; Which is better, -r or -R?
3403 (call-process "rm" nil nil nil "-r" (directory-file-name fn))
3404 (and (file-exists-p fn)
3405 (error "Failed to recusively delete %s" fn))))))
3406
3407 (defun dired-clean-up-after-deletion (fn)
3408 ;; Offer to kill buffer of deleted file FN.
3409 (let ((buf (get-file-buffer fn)))
3410 (and buf
3411 (or (memq 'kill-file-buffer dired-no-confirm)
3412 (funcall (function yes-or-no-p)
3413 (format "Kill buffer of %s, too? "
3414 (file-name-nondirectory fn))))
3415 (save-excursion ; you never know where kill-buffer leaves you
3416 (kill-buffer buf)))))
3417
3418 ;;; Cleaning a directory -- flagging backups for deletion
3419
3420 (defun dired-clean-directory (keep &optional marker msg)
3421 "Flag numerical backups for deletion.
3422 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
3423 Positive prefix arg KEEP overrides `dired-kept-versions';
3424 Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
3425
3426 To clear the flags on these files, you can use \\[dired-flag-backup-files]
3427 with a prefix argument."
3428 (interactive "P")
3429 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
3430 (let* ((early-retention (if (< keep 0) (- keep) kept-old-versions))
3431 (late-retention (if (<= keep 0) dired-kept-versions keep))
3432 (msg (or msg
3433 (format
3434 "Cleaning numerical backups (keeping %d late, %d old)"
3435 late-retention early-retention)))
3436 (trample-marker (or marker dired-del-marker))
3437 (file-version-assoc-list))
3438 (message "%s..." msg)
3439 ;; Do this after messaging, as it may take a while.
3440 (setq file-version-assoc-list (dired-collect-file-versions))
3441 ;; Sort each VERSION-NUMBER-LIST,
3442 ;; and remove the versions to be deleted.
3443 (let ((fval file-version-assoc-list))
3444 (while fval
3445 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
3446 (v-count (length sorted-v-list)))
3447 (if (> v-count (+ early-retention late-retention))
3448 (rplacd (nthcdr early-retention sorted-v-list)
3449 (nthcdr (- v-count late-retention)
3450 sorted-v-list)))
3451 (rplacd (car fval)
3452 (cdr sorted-v-list)))
3453 (setq fval (cdr fval))))
3454 ;; Look at each file. If it is a numeric backup file,
3455 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
3456 (dired-map-dired-file-lines (function
3457 (lambda (fn)
3458 (dired-trample-file-versions
3459 fn file-version-assoc-list
3460 trample-marker))))
3461 (message "%s...done" msg)))
3462
3463 (defun dired-collect-file-versions ()
3464 ;; If it looks like a file has versions, return a list of the versions.
3465 ;; The return value is ((FILENAME . (VERSION1 VERSION2 ...)) ...)
3466 (let (result)
3467 (dired-map-dired-file-lines
3468 (function
3469 (lambda (fn)
3470 (let* ((base-versions
3471 (concat (file-name-nondirectory fn) ".~"))
3472 (bv-length (length base-versions))
3473 (possibilities (file-name-all-completions
3474 base-versions
3475 (file-name-directory fn))))
3476 (if possibilities
3477 (setq result (cons (cons fn
3478 (mapcar 'backup-extract-version
3479 possibilities)) result)))))))
3480 result))
3481
3482 (defun dired-trample-file-versions (fn alist marker)
3483 ;; ALIST is an alist of filenames and versions used to determine
3484 ;; if each file should be flagged for deletion.
3485 ;; This version using file-name-sans-versions is probably a lot slower
3486 ;; than Sebastian's original, but it is more easily adaptable to non-unix.
3487 (let ((base (file-name-sans-versions fn))
3488 base-version-list bv-length)
3489 (and (not (string-equal base fn))
3490 (setq base-version-list (assoc base alist))
3491 (setq bv-length (string-match "[0-9]" fn (length base)))
3492 (not (memq (backup-extract-version fn) base-version-list))
3493 (progn (skip-chars-backward "^\n\r")
3494 (bolp)) ; make sure the preceding char isn't \r.
3495 (dired-substitute-marker (point) (following-char) marker))))
3496
3497 (defun dired-map-dired-file-lines (fun)
3498 ;; Perform FUN with point at the end of each non-directory line.
3499 ;; FUN takes one argument, the filename (complete pathname).
3500 (dired-check-ls-l)
3501 (save-excursion
3502 (let (file buffer-read-only)
3503 (goto-char (point-min))
3504 (while (not (eobp))
3505 (save-excursion
3506 (and (not (and dired-re-dir (looking-at dired-re-dir)))
3507 (not (memq (following-char) '(?\n ?\n)))
3508 (setq file (dired-get-filename nil t)) ; nil on non-file
3509 (progn (skip-chars-forward "^\n\r")
3510 (funcall fun file))))
3511 (forward-line 1))))) ; this guarantees that we don't
3512 ; operate on omitted files.
3513
3514
3515 ;;;; -----------------------------------------------------------
3516 ;;;; Confirmations and prompting the user.
3517 ;;;; -----------------------------------------------------------
3518
3519 (defun dired-plural-s (count)
3520 (if (= 1 count) "" "s"))
3521
3522 (defun dired-mark-prompt (arg files &optional marker-char)
3523 ;; Return a string for use in a prompt, either the current file
3524 ;; name, or the marker and a count of marked files.
3525 (let ((count (length files)))
3526 (if (= count 1)
3527 (car files)
3528 ;; more than 1 file:
3529 (if (integerp arg)
3530 (cond ((zerop arg) "[no files]")
3531 ((> arg 0) "[following]")
3532 ((< arg 0) "[preceding]"))
3533 (char-to-string (or marker-char dired-marker-char))))))
3534
3535 (defun dired-pop-to-buffer (buf)
3536 ;; Pop up buffer BUF.
3537 ;; Make its window fit its contents.
3538 (let ((window (selected-window))
3539 target-lines w2)
3540 (cond ;; if split-window-threshold is enabled, use the largest window
3541 ((and (> (window-height (setq w2 (get-largest-window)))
3542 split-height-threshold)
3543 (= (frame-width) (window-width w2)))
3544 (setq window w2))
3545 ;; if the least-recently-used window is big enough, use it
3546 ((and (> (window-height (setq w2 (get-lru-window)))
3547 (* 2 window-min-height))
3548 (= (frame-width) (window-width w2)))
3549 (setq window w2)))
3550 (save-excursion
3551 (set-buffer buf)
3552 (goto-char (point-max))
3553 (skip-chars-backward "\n\r\t ")
3554 (setq target-lines (count-lines (point-min) (point)))
3555 ;; Don't forget to count the last line.
3556 (if (not (bolp))
3557 (setq target-lines (1+ target-lines))))
3558 (if (<= (window-height window) (* 2 window-min-height))
3559 ;; At this point, every window on the frame is too small to split.
3560 (setq w2 (display-buffer buf))
3561 (setq w2 (split-window
3562 window
3563 (max window-min-height
3564 (- (window-height window)
3565 (1+ (max window-min-height target-lines)))))))
3566 (set-window-buffer w2 buf)
3567 (if (< (1- (window-height w2)) target-lines)
3568 (progn
3569 (select-window w2)
3570 (enlarge-window (- target-lines (1- (window-height w2))))))
3571 (set-window-start w2 1)))
3572
3573 (defun dired-mark-pop-up (bufname op-symbol files function &rest args)
3574 ;; Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
3575 ;; Return FUNCTION's result on ARGS after popping up a window (in a buffer
3576 ;; named BUFNAME, nil gives \" *Marked Files*\") showing the marked
3577 ;; files. Uses function `dired-pop-to-buffer' to do that.
3578 ;; FUNCTION should not manipulate files.
3579 ;; It should only read input (an argument or confirmation).
3580 ;; The window is not shown if there is just one file or
3581 ;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
3582 ;; FILES is the list of marked files.
3583 (if (memq op-symbol dired-no-confirm)
3584 (apply function args)
3585 (or bufname (setq bufname " *Marked Files*"))
3586 (if (<= (length files) 1)
3587 (apply function args)
3588 (save-excursion
3589 (let ((standard-output (set-buffer (get-buffer-create bufname))))
3590 (erase-buffer)
3591 (dired-format-columns-of-files files)
3592 (dired-remove-text-properties (point-min) (point-max))
3593 (setq mode-line-format (format " %s [%d files]"
3594 bufname (length files)))))
3595 (save-window-excursion
3596 (dired-pop-to-buffer bufname)
3597 (apply function args)))))
3598
3599 (defun dired-column-widths (columns list &optional across)
3600 ;; Returns the column widths for breaking LIST into
3601 ;; COLUMNS number of columns.
3602 (cond
3603 ((null list)
3604 nil)
3605 ((= columns 1)
3606 (list (apply 'max (mapcar 'length list))))
3607 ((let* ((len (length list))
3608 (col-length (/ len columns))
3609 (remainder (% len columns))
3610 (i 0)
3611 (j 0)
3612 (max-width 0)
3613 widths padding)
3614 (if (zerop remainder)
3615 (setq padding 0)
3616 (setq col-length (1+ col-length)
3617 padding (- columns remainder)))
3618 (setq list (nconc (copy-sequence list) (make-list padding nil)))
3619 (setcdr (nthcdr (1- (+ len padding)) list) list)
3620 (while (< i columns)
3621 (while (< j col-length)
3622 (setq max-width (max max-width (length (car list)))
3623 list (if across (nthcdr columns list) (cdr list))
3624 j (1+ j)))
3625 (setq widths (cons (+ max-width 2) widths)
3626 max-width 0
3627 j 0
3628 i (1+ i))
3629 (if across (setq list (cdr list))))
3630 (setcar widths (- (car widths) 2))
3631 (nreverse widths)))))
3632
3633 (defun dired-calculate-columns (list &optional across)
3634 ;; Returns a list of integers which are the column widths that best pack
3635 ;; LIST, a list of strings, onto the screen.
3636 (and list
3637 (let* ((width (1- (window-width)))
3638 (columns (max 1 (/ width
3639 (+ 2 (apply 'max (mapcar 'length list))))))
3640 col-list last-col-list)
3641 (while (<= (apply '+ (setq col-list
3642 (dired-column-widths columns list across)))
3643 width)
3644 (setq columns (1+ columns)
3645 last-col-list col-list))
3646 (or last-col-list col-list))))
3647
3648 (defun dired-format-columns-of-files (files &optional across)
3649 ;; Returns the number of lines used.
3650 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
3651 ;; ls -x
3652 (and files
3653 (let* ((columns (dired-calculate-columns files across))
3654 (ncols (length columns))
3655 (ncols1 (1- ncols))
3656 (nfiles (length files))
3657 (nrows (+ (/ nfiles ncols)
3658 (if (zerop (% nfiles ncols)) 0 1)))
3659 (space-left (- (window-width) (apply '+ columns) 1))
3660 (i 0)
3661 (j 0)
3662 file padding stretch float-stretch)
3663 (if (zerop ncols1)
3664 (setq stretch 0
3665 float-stretch 0)
3666 (setq stretch (/ space-left ncols1)
3667 float-stretch (% space-left ncols1)))
3668 (setq files (nconc (copy-sequence files) ; fill up with empty fns
3669 (make-list (- (* ncols nrows) nfiles) "")))
3670 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
3671 (while (< j nrows)
3672 (while (< i ncols)
3673 (princ (setq file (car files)))
3674 (setq padding (- (nth i columns) (length file)))
3675 (or (= i ncols1)
3676 (progn
3677 (setq padding (+ padding stretch))
3678 (if (< i float-stretch) (setq padding (1+ padding)))))
3679 (princ (make-string padding ?\ ))
3680 (setq files (if across (cdr files) (nthcdr nrows files))
3681 i (1+ i)))
3682 (princ "\n")
3683 (setq i 0
3684 j (1+ j))
3685 (or across (setq files (cdr files))))
3686 nrows)))
3687
3688 (defun dired-query (qs-var qs-prompt &rest qs-args)
3689 ;; Query user and return nil or t.
3690 ;; Store answer in symbol VAR (which must initially be bound to nil).
3691 ;; Format PROMPT with ARGS.
3692 ;; Binding variable help-form will help the user who types C-h.
3693 (let* ((char (symbol-value qs-var))
3694 (action (cdr (assoc char dired-query-alist))))
3695 (cond ((eq 'yes action)
3696 t) ; accept, and don't ask again
3697 ((eq 'no action)
3698 nil) ; skip, and don't ask again
3699 (t;; no lasting effects from last time we asked - ask now
3700 (let ((qprompt (concat qs-prompt
3701 (if help-form
3702 (format " [yn!q or %s] "
3703 (key-description
3704 (char-to-string help-char)))
3705 " [ynq or !] ")))
3706 (dired-in-query t)
3707 elt)
3708 ;; Actually it looks nicer without cursor-in-echo-area - you can
3709 ;; look at the dired buffer instead of at the prompt to decide.
3710 (apply 'message qprompt qs-args)
3711 (setq char (set qs-var (read-char)))
3712 (while (not (setq elt (assoc char dired-query-alist)))
3713 (message "Invalid char - type %c for help." help-char)
3714 (ding)
3715 (sit-for 1)
3716 (apply 'message qprompt qs-args)
3717 (setq char (set qs-var (read-char))))
3718 (memq (cdr elt) '(t y yes)))))))
3719
3720 (defun dired-mark-confirm (op-symbol operation arg)
3721 ;; Request confirmation from the user that the operation described
3722 ;; by OP-SYMBOL is to be performed on the marked files.
3723 ;; Confirmation consists in a y-or-n question with a file list
3724 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
3725 ;; OPERATION is a string describing the operation. Used for prompting
3726 ;; the user.
3727 ;; The files used are determined by ARG (like in dired-get-marked-files).
3728 (or (memq op-symbol dired-no-confirm)
3729 (let ((files (dired-get-marked-files t arg)))
3730 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
3731 (concat operation " "
3732 (dired-mark-prompt arg files) "? ")))))
3733
3734 (defun dired-mark-read-file-name (prompt dir op-symbol arg files)
3735 (dired-mark-pop-up
3736 nil op-symbol files
3737 (function read-file-name)
3738 (format prompt (dired-mark-prompt arg files)) dir))
3739
3740 (defun dired-mark-read-string (prompt initial op-symbol arg files
3741 &optional history-sym)
3742 ;; Reading arguments with history.
3743 ;; Read arguments for a mark command of type OP-SYMBOL,
3744 ;; perhaps popping up the list of marked files.
3745 ;; ARG is the prefix arg and indicates whether the files came from
3746 ;; marks (ARG=nil) or a repeat factor (integerp ARG).
3747 ;; If the current file was used, the list has but one element and ARG
3748 ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
3749 ;; PROMPT for a string, with INITIAL input.
3750 (dired-mark-pop-up
3751 nil op-symbol files
3752 (function
3753 (lambda (prompt initial)
3754 (let ((hist (or history-sym
3755 (cdr (assq op-symbol dired-op-history-alist))
3756 'dired-history)))
3757 (dired-read-with-history prompt initial hist))))
3758 (format prompt (dired-mark-prompt arg files)) initial))
3759
3760
3761 ;;;; ----------------------------------------------------------
3762 ;;;; Marking files.
3763 ;;;; ----------------------------------------------------------
3764
3765 (defun dired-mark (arg &optional char)
3766 "Mark the current (or next ARG) files.
3767 If on a subdir headerline, mark all its files except `.' and `..'.
3768
3769 Use \\[dired-unmark-all-files] to remove all marks,
3770 and \\[dired-unmark] to remove the mark of the current file."
3771 (interactive "p")
3772 (if (dired-get-subdir)
3773 (dired-mark-subdir-files char)
3774 (dired-mark-file arg char)))
3775
3776 (defun dired-mark-file (arg &optional char)
3777 "Mark ARG files starting from the current file line.
3778 Optional CHAR indicates a marker character to use."
3779 (let (buffer-read-only)
3780 (if (memq (or char dired-marker-char) '(?\ ?\n ?\r))
3781 (error "Invalid marker charcter %c" dired-marker-char))
3782 (or char (setq char dired-marker-char))
3783 (dired-repeat-over-lines
3784 arg
3785 (function
3786 (lambda ()
3787 (dired-update-marker-counters (following-char) t)
3788 (dired-substitute-marker (point) (following-char) char)
3789 (dired-update-marker-counters char))))
3790 (dired-update-mode-line-modified)))
3791
3792 (defun dired-mark-subdir-files (&optional char)
3793 "Mark all files except `.' and `..'."
3794 (interactive)
3795 (save-excursion
3796 (dired-mark-files-in-region (dired-subdir-min) (dired-subdir-max) char)))
3797
3798 (defun dired-unmark (arg)
3799 "Unmark the current (or next ARG) files.
3800 If looking at a subdir, unmark all its files except `.' and `..'."
3801 (interactive "p")
3802 (let (buffer-read-only)
3803 (dired-repeat-over-lines
3804 arg
3805 (function
3806 (lambda ()
3807 (let ((char (following-char)))
3808 (or (memq char '(?\ ?\n ?\r))
3809 (progn
3810 (cond
3811 ((char-equal char dired-marker-char)
3812 (setq dired-marks-number (max (1- dired-marks-number) 0)))
3813 ((char-equal char dired-del-marker)
3814 (setq dired-del-flags-number
3815 (max (1- dired-del-flags-number) 0)))
3816 ((setq dired-other-marks-number
3817 (max (1- dired-other-marks-number) 0))))
3818 (dired-substitute-marker (point) char ?\ )))))))
3819 (dired-update-mode-line-modified)))
3820
3821 (defun dired-mark-prefix (&optional arg)
3822 "Mark the next ARG files with the next character typed.
3823 If ARG is negative, marks the previous files."
3824 (interactive "p")
3825 (if (sit-for echo-keystrokes)
3826 (cond
3827 ((or (= arg 1) (zerop arg))
3828 (message "Mark with character?"))
3829 ((< arg 0)
3830 (message "Mark %d file%s moving backwards?"
3831 (- arg) (dired-plural-s (- arg))))
3832 ((> arg 1)
3833 (message "Mark %d following files with character?" arg))))
3834 (dired-mark arg (read-char)))
3835
3836 (defun dired-change-marks (old new)
3837 "Change all OLD marks to NEW marks.
3838 OLD and NEW are both characters used to mark files.
3839 With a prefix, prompts for a mark to toggle. In other words, all unmarked
3840 files receive that mark, and all files currently marked with that mark become
3841 unmarked."
3842 ;; When used in a lisp program, setting NEW to nil means toggle the mark OLD.
3843 (interactive
3844 (let* ((cursor-in-echo-area t)
3845 (old nil)
3846 (new nil)
3847 (markers (dired-mark-list))
3848 (default (cond ((null markers)
3849 (error "No markers in buffer"))
3850 ((= (length markers) 1)
3851 (setq old (car markers)))
3852 ((memq dired-marker-char markers)
3853 dired-marker-char)
3854 ;; picks the last one in the buffer. reasonable?
3855 ((car markers)))))
3856 (or old (setq old
3857 (progn
3858 (if current-prefix-arg
3859 (message "Toggle mark (default %c): " default)
3860 (message "Change old mark (default %c): " default))
3861 (read-char))))
3862 (if (memq old '(?\ ?\n ?\r)) (setq old default))
3863 (or current-prefix-arg
3864 (setq new (progn
3865 (message
3866 "Change %c marks to new mark (RET means abort): " old)
3867 (read-char))))
3868 (list old new)))
3869 (let ((old-count (cond
3870 ((char-equal old dired-marker-char)
3871 'dired-marks-number)
3872 ((char-equal old dired-del-marker)
3873 'dired-del-flags-number)
3874 ('dired-other-marks-number))))
3875 (if new
3876 (or (memq new '(?\ ?\n ?\r))
3877 ;; \n and \r aren't valid marker chars. Assume that if the
3878 ;; user hits return, he meant to abort the command.
3879 (let ((string (format "\n%c" old))
3880 (new-count (cond
3881 ((char-equal new dired-marker-char)
3882 'dired-marks-number)
3883 ((char-equal new dired-del-marker)
3884 'dired-del-flags-number)
3885 ('dired-other-marks-number)))
3886 (buffer-read-only nil))
3887 (save-excursion
3888 (goto-char (point-min))
3889 (while (search-forward string nil t)
3890 (if (char-equal (preceding-char) old)
3891 (progn
3892 (dired-substitute-marker (1- (point)) old new)
3893 (set new-count (1+ (symbol-value new-count)))
3894 (set old-count (max (1- (symbol-value old-count)) 0))))
3895 ))))
3896 (save-excursion
3897 (let ((ucount 0)
3898 (mcount 0)
3899 (buffer-read-only nil))
3900 (goto-char (point-min))
3901 (while (not (eobp))
3902 (or (dired-between-files)
3903 (looking-at dired-re-dot)
3904 (cond
3905 ((= (following-char) ?\ )
3906 (setq mcount (1+ mcount))
3907 (set old-count (1+ (symbol-value old-count)))
3908 (dired-substitute-marker (point) ?\ old))
3909 ((= (following-char) old)
3910 (setq ucount (1+ ucount))
3911 (set old-count (max (1- (symbol-value old-count)) 0))
3912 (dired-substitute-marker (point) old ?\ ))))
3913 (forward-line 1))
3914 (message "Unmarked %d file%s; marked %d file%s with %c."
3915 ucount (dired-plural-s ucount) mcount
3916 (dired-plural-s mcount) old)))))
3917 (dired-update-mode-line-modified))
3918
3919 (defun dired-unmark-all-files (flag &optional arg)
3920 "Remove a specific mark or any mark from every file.
3921 With prefix arg, query for each marked file.
3922 Type \\[help-command] at that time for help.
3923 With a zero prefix, only counts the number of marks."
3924 (interactive
3925 (let* ((cursor-in-echo-area t)
3926 executing-kbd-macro) ; for XEmacs
3927 (list (and (not (eq current-prefix-arg 0))
3928 (progn (message "Remove marks (RET means all): ") (read-char)))
3929 current-prefix-arg)))
3930 (save-excursion
3931 (let* ((help-form "\
3932 Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
3933 `!' to unflag all remaining files with no more questions.")
3934 (allp (memq flag '(?\n ?\r)))
3935 (count-p (eq arg 0))
3936 (count (if (or allp count-p)
3937 (mapcar
3938 (function
3939 (lambda (elt)
3940 (cons elt 0)))
3941 (nreverse (dired-mark-list)))
3942 0))
3943 (msg "")
3944 (no-query (or (not arg) count-p))
3945 buffer-read-only case-fold-search query)
3946 (goto-char (point-min))
3947 (if (or allp count-p)
3948 (while (re-search-forward dired-re-mark nil t)
3949 (if (or no-query
3950 (dired-query 'query "Unmark file `%s'? "
3951 (dired-get-filename t)))
3952 (let ((ent (assq (preceding-char) count)))
3953 (if ent (setcdr ent (1+ (cdr ent))))
3954 (or count-p (dired-substitute-marker
3955 (- (point) 1) (preceding-char) ?\ ))))
3956 (forward-line 1))
3957 (while (search-forward (format "\n%c" flag) nil t)
3958 (if (or no-query
3959 (dired-query 'query "Unmark file `%s'? "
3960 (dired-get-filename t)))
3961 (progn
3962 (dired-substitute-marker (match-beginning 0) flag ?\ )
3963 (setq count (1+ count))))))
3964 (if (or allp count-p)
3965 (mapcar
3966 (function
3967 (lambda (elt)
3968 (or (zerop (cdr elt))
3969 (setq msg (format "%s%s%d %c%s"
3970 msg
3971 (if (zerop (length msg))
3972 " "
3973 ", ")
3974 (cdr elt)
3975 (car elt)
3976 (if (= 1 (cdr elt)) "" "'s"))))))
3977 count)
3978 (or (zerop count)
3979 (setq msg (format " %d %c%s"
3980 count flag (if (= 1 count) "" "'s")))))
3981 (if (zerop (length msg))
3982 (setq msg " none")
3983 (or count-p (dired-update-mode-line-modified t)))
3984 (message "%s:%s" (if count-p "Number of marks" "Marks removed") msg))))
3985
3986 (defun dired-get-marked-files (&optional localp arg)
3987 "Return the marked files' names as list of strings.
3988 The list is in the same order as the buffer, that is, the car is the
3989 first marked file.
3990 Values returned are normally absolute pathnames.
3991 Optional arg LOCALP as in `dired-get-filename'.
3992 Optional second argument ARG forces to use other files. If ARG is an
3993 integer, use the next ARG files. If ARG is otherwise non-nil, use
3994 current file. Usually ARG comes from the current prefix arg."
3995 (save-excursion
3996 (nreverse (dired-map-over-marks (dired-get-filename localp) arg))))
3997
3998 ;;; Utility functions for marking files
3999
4000 (defun dired-mark-files-in-region (start end &optional char)
4001 (let (buffer-read-only)
4002 (if (> start end)
4003 (error "start > end"))
4004 (goto-char start) ; assumed at beginning of line
4005 (or char (setq char dired-marker-char))
4006 (while (< (point) end)
4007 ;; Skip subdir line and following garbage like the `total' line:
4008 (while (and (< (point) end) (dired-between-files))
4009 (forward-line 1))
4010 (if (and (/= (following-char) char)
4011 (not (looking-at dired-re-dot))
4012 (save-excursion
4013 (dired-move-to-filename nil (point))))
4014 (progn
4015 (dired-update-marker-counters (following-char) t)
4016 (dired-substitute-marker (point) (following-char) char)
4017 (dired-update-marker-counters char)))
4018 (forward-line 1)))
4019 (dired-update-mode-line-modified))
4020
4021 (defun dired-mark-list ()
4022 ;; Returns a list of all marks currently used in the buffer.
4023 (let ((result nil)
4024 char)
4025 (save-excursion
4026 (goto-char (point-min))
4027 (while (not (eobp))
4028 (and (not (memq (setq char (following-char)) '(?\ ?\n ?\r)))
4029 (not (memq char result))
4030 (setq result (cons char result)))
4031 (forward-line 1)))
4032 result))
4033
4034 ;;; Dynamic markers
4035
4036 (defun dired-set-current-marker-string ()
4037 "Computes and returns `dired-marker-string'."
4038 (prog1
4039 (setq dired-marker-string
4040 (if dired-marker-stack
4041 (let* ((n (+ (length dired-marker-stack) 5))
4042 (str (make-string n ?\ ))
4043 (list dired-marker-stack)
4044 (pointer dired-marker-stack-pointer))
4045 (setq n (1- n))
4046 (aset str n ?\])
4047 (setq n (1- n))
4048 (while list
4049 (aset str n (car list))
4050 (if (zerop pointer)
4051 (progn
4052 (setq n (1- n))
4053 (aset str n dired-marker-stack-cursor)))
4054 (setq n (1- n)
4055 pointer (1- pointer)
4056 list (cdr list)))
4057 (aset str n dired-default-marker)
4058 (if (zerop pointer)
4059 (aset str 2 dired-marker-stack-cursor))
4060 (aset str 1 ?\[)
4061 str)
4062 ""))
4063 (set-buffer-modified-p (buffer-modified-p))))
4064
4065 (defun dired-set-marker-char (c)
4066 "Set the marker character to something else.
4067 Use \\[dired-restore-marker-char] to restore the previous value."
4068 (interactive "cNew marker character: ")
4069 (and (memq c '(?\ ?\n ?\r)) (error "invalid marker char %c" c))
4070 (setq dired-marker-stack (cons c dired-marker-stack)
4071 dired-marker-stack-pointer 0
4072 dired-marker-char c)
4073 (dired-update-mode-line-modified t)
4074 (dired-set-current-marker-string))
4075
4076 (defun dired-restore-marker-char ()
4077 "Restore the marker character to its previous value.
4078 Uses `dired-default-marker' if the marker stack is empty."
4079 (interactive)
4080 (setq dired-marker-stack (cdr dired-marker-stack)
4081 dired-marker-char (car dired-marker-stack)
4082 dired-marker-stack-pointer (min dired-marker-stack-pointer
4083 (length dired-marker-stack)))
4084 (or dired-marker-char
4085 (setq dired-marker-char dired-default-marker))
4086 (dired-set-current-marker-string)
4087 (dired-update-mode-line-modified t)
4088 (or dired-marker-stack (message "Marker is %c" dired-marker-char)))
4089
4090 (defun dired-marker-stack-left (n)
4091 "Moves the marker stack cursor to the left."
4092 (interactive "p")
4093 (let ((len (1+ (length dired-marker-stack))))
4094 (or dired-marker-stack (error "Dired marker stack is empty."))
4095 (setq dired-marker-stack-pointer
4096 (% (+ dired-marker-stack-pointer n) len))
4097 (if (< dired-marker-stack-pointer 0)
4098 (setq dired-marker-stack-pointer (+ dired-marker-stack-pointer
4099 len)))
4100 (dired-set-current-marker-string)
4101 (setq dired-marker-char
4102 (if (= dired-marker-stack-pointer (1- len))
4103 dired-default-marker
4104 (nth dired-marker-stack-pointer dired-marker-stack))))
4105 (dired-update-mode-line-modified t))
4106
4107 (defun dired-marker-stack-right (n)
4108 "Moves the marker stack cursor to the right."
4109 (interactive "p")
4110 (dired-marker-stack-left (- n)))
4111
4112 ;;; Commands to mark or flag files based on their characteristics or names.
4113
4114 (defun dired-mark-symlinks (&optional unflag-p)
4115 "Mark all symbolic links.
4116 With prefix argument, unflag all those files."
4117 (interactive "P")
4118 (dired-check-ls-l)
4119 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
4120 (dired-mark-if (looking-at dired-re-sym) "symbolic link"))
4121 (dired-update-mode-line-modified t))
4122
4123 (defun dired-mark-directories (&optional unflag-p)
4124 "Mark all directory file lines except `.' and `..'.
4125 With prefix argument, unflag all those files."
4126 (interactive "P")
4127 (if dired-re-dir
4128 (progn
4129 (dired-check-ls-l)
4130 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
4131 (dired-mark-if (and (looking-at dired-re-dir)
4132 (not (looking-at dired-re-dot)))
4133 "directory file"))))
4134 (dired-update-mode-line-modified t))
4135
4136 (defun dired-mark-executables (&optional unflag-p)
4137 "Mark all executable files.
4138 With prefix argument, unflag all those files."
4139 (interactive "P")
4140 (if dired-re-exe
4141 (progn
4142 (dired-check-ls-l)
4143 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
4144 (dired-mark-if (looking-at dired-re-exe) "executable file"))))
4145 (dired-update-mode-line-modified t))
4146
4147 (defun dired-flag-backup-files (&optional unflag-p)
4148 "Flag all backup files (names ending with `~') for deletion.
4149 With prefix argument, unflag these files."
4150 (interactive "P")
4151 (dired-check-ls-l)
4152 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
4153 (dired-mark-if
4154 (and (not (and dired-re-dir (looking-at dired-re-dir)))
4155 (let ((fn (dired-get-filename t t)))
4156 (if fn (backup-file-name-p fn))))
4157 "backup file"))
4158 (dired-update-mode-line-modified t))
4159
4160 (defun dired-flag-auto-save-files (&optional unflag-p)
4161 "Flag for deletion files whose names suggest they are auto save files.
4162 A prefix argument says to unflag those files instead."
4163 (interactive "P")
4164 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
4165 (dired-mark-if
4166 ;; It is less than general to check for ~ here,
4167 ;; but it's the only way this runs fast enough.
4168 (and (save-excursion (end-of-line)
4169 (eq (preceding-char) ?#))
4170 (not (and dired-re-dir (looking-at dired-re-dir)))
4171 (let ((fn (dired-get-filename t t)))
4172 (if fn (auto-save-file-name-p
4173 (file-name-nondirectory fn)))))
4174 "auto save file"))
4175 (dired-update-mode-line-modified t))
4176
4177 (defun dired-mark-rcs-files (&optional unflag-p)
4178 "Mark all files that are under RCS control.
4179 With prefix argument, unflag all those files.
4180 Mentions RCS files for which a working file was not found in this buffer.
4181 Type \\[dired-why] to see them again."
4182 ;; Returns failures, or nil on success.
4183 ;; Finding those with locks would require to peek into the ,v file,
4184 ;; depends slightly on the RCS version used and should be done
4185 ;; together with the Emacs RCS interface.
4186 ;; Unfortunately, there is no definitive RCS interface yet.
4187 (interactive "P")
4188 (message "%sarking RCS controlled files..." (if unflag-p "Unm" "M"))
4189 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char))
4190 rcs-files wf failures count total)
4191 (mapcar ; loop over subdirs
4192 (function
4193 (lambda (dir)
4194 (or (equal (file-name-nondirectory (directory-file-name dir))
4195 "RCS")
4196 ;; skip inserted RCS subdirs
4197 (setq rcs-files
4198 (append (directory-files dir t ",v$") ; *,v and RCS/*,v
4199 (let ((rcs-dir (expand-file-name "RCS" dir)))
4200 (if (file-directory-p rcs-dir)
4201 (mapcar ; working files from ./RCS are in ./
4202 (function
4203 (lambda (x)
4204 (expand-file-name x dir)))
4205 (directory-files
4206 (file-name-as-directory rcs-dir)
4207 nil ",v$"))))
4208 rcs-files)))))
4209 (mapcar (function car) dired-subdir-alist))
4210 (setq total (length rcs-files))
4211 (while rcs-files
4212 (setq wf (substring (car rcs-files) 0 -2)
4213 rcs-files (cdr rcs-files))
4214 (save-excursion (if (dired-goto-file wf)
4215 (dired-mark 1) ; giving a prefix avoids checking
4216 ; for subdir line.
4217 (setq failures (cons wf failures)))))
4218 (dired-update-mode-line-modified t)
4219 (if (null failures)
4220 (message "%d RCS file%s %smarked."
4221 total (dired-plural-s total) (if unflag-p "un" ""))
4222 (setq count (length failures))
4223 (dired-log-summary (buffer-name (current-buffer))
4224 "RCS working file not found %s" failures)
4225 (message "%d RCS file%s: %d %smarked - %d not found %s."
4226 total (dired-plural-s total) (- total count)
4227 (if unflag-p "un" "") count failures))
4228 failures))
4229
4230
4231 ;;;; ------------------------------------------------------------
4232 ;;;; Logging failures
4233 ;;;; ------------------------------------------------------------
4234
4235 (defun dired-why ()
4236 "Pop up a buffer with error log output from Dired.
4237 A group of errors from a single command ends with a formfeed.
4238 Thus, use \\[backward-page] to find the beginning of a group of errors."
4239 (interactive)
4240 (if (get-buffer dired-log-buffer)
4241 (let ((owindow (selected-window))
4242 (window (display-buffer (get-buffer dired-log-buffer))))
4243 (unwind-protect
4244 (progn
4245 (select-window window)
4246 (goto-char (point-max))
4247 (recenter -1))
4248 (select-window owindow)))))
4249
4250 (defun dired-log (buffer-name log &rest args)
4251 ;; Log a message or the contents of a buffer.
4252 ;; BUFFER-NAME is the name of the dired buffer to which the message applies.
4253 ;; If LOG is a string and there are more args, it is formatted with
4254 ;; those ARGS. Usually the LOG string ends with a \n.
4255 ;; End each bunch of errors with (dired-log t): this inserts
4256 ;; current time and buffer, and a \f (formfeed).
4257 (or (stringp buffer-name) (setq buffer-name (buffer-name buffer-name)))
4258 (let ((obuf (current-buffer)))
4259 (unwind-protect ; want to move point
4260 (progn
4261 (set-buffer (get-buffer-create dired-log-buffer))
4262 (goto-char (point-max))
4263 (let (buffer-read-only)
4264 (cond ((stringp log)
4265 (insert (if args
4266 (apply (function format) log args)
4267 log)))
4268 ((bufferp log)
4269 (insert-buffer log))
4270 ((eq t log)
4271 (insert "\n\t" (current-time-string)
4272 "\tBuffer `" buffer-name "'\n\f\n")))))
4273 (set-buffer obuf))))
4274
4275 (defun dired-log-summary (buffer-name string failures)
4276 (message (if failures "%s--type y for details %s"
4277 "%s--type y for details")
4278 string failures)
4279 ;; Log a summary describing a bunch of errors.
4280 (dired-log buffer-name (concat "\n" string))
4281 (if failures (dired-log buffer-name "\n%s" failures))
4282 (dired-log buffer-name t))
4283
4284
4285 ;;;; -------------------------------------------------------
4286 ;;;; Sort mode of dired buffers.
4287 ;;;; -------------------------------------------------------
4288
4289 (defun dired-sort-type (list)
4290 ;; Returns the sort type of LIST, as a symbol.
4291 (let* ((list (reverse list))
4292 (alist (sort
4293 (mapcar (function
4294 (lambda (x)
4295 (cons (length (memq (car x) list)) (cdr x))))
4296 dired-sort-type-alist)
4297 (function
4298 (lambda (x y)
4299 (> (car x) (car y))))))
4300 (winner (car alist)))
4301 (if (zerop (car winner))
4302 'name
4303 (cdr winner))))
4304
4305 (defun dired-sort-set-modeline (&optional switches)
4306 ;; Set modeline display according to dired-internal-switches.
4307 ;; Modeline display of "by name" or "by date" guarantees the user a
4308 ;; match with the corresponding regexps. Non-matching switches are
4309 ;; shown literally.
4310 (or switches (setq switches dired-internal-switches))
4311 (setq dired-sort-mode
4312 (if dired-show-ls-switches
4313 (concat " " (dired-make-switches-string
4314 (or switches dired-internal-switches)))
4315 (concat " by " (and (memq ?r switches) "rev-")
4316 (symbol-name (dired-sort-type switches)))))
4317 ;; update mode line
4318 (set-buffer-modified-p (buffer-modified-p)))
4319
4320 (defun dired-sort-toggle-or-edit (&optional arg)
4321 "Toggle between sort by date/name for the current subdirectory.
4322
4323 With a 0 prefix argument, simply reports on the current switches.
4324
4325 With a prefix 1 allows the ls switches for the current subdirectory to be
4326 edited.
4327
4328 With a prefix 2 allows the default ls switches for newly inserted
4329 subdirectories to be edited.
4330
4331 With a prefix \\[universal-argument] allows you to sort the entire
4332 buffer by either name or date.
4333
4334 With a prefix \\[universal-argument] \\[universal-argument] allows the default switches
4335 for the entire buffer to be edited, and then reverts the buffer so that all
4336 subdirectories are sorted according to these switches.
4337
4338 Note that although dired allows different ls switches to be used for
4339 different subdirectories, certain combinations of ls switches are incompatible.
4340 If incompatible switches are detected, dired will offer to revert the buffer
4341 to force the ls switches for all subdirectories to a single value. If you
4342 refuse to revert the buffer, any change of ls switches will be aborted."
4343 (interactive "P")
4344 (cond
4345 ((eq arg 0)
4346 ;; Report on switches
4347 (message "Switches for current subdir: %s. Default for buffer: %s."
4348 (dired-make-switches-string
4349 (nth 3 (assoc (dired-current-directory) dired-subdir-alist)))
4350 (dired-make-switches-string dired-internal-switches)))
4351 ((null arg)
4352 ;; Toggle between sort by date/name.
4353 (let* ((dir (dired-current-directory))
4354 (curr (nth 3 (assoc dir dired-subdir-alist))))
4355 (dired-sort-other
4356 (if (eq (dired-sort-type curr) 'name)
4357 (cons ?t curr)
4358 (mapcar (function
4359 (lambda (x)
4360 (setq curr
4361 (delq (car x) curr))))
4362 dired-sort-type-alist)
4363 curr)
4364 nil dir)))
4365 ((eq arg 1)
4366 ;; Edit switches for current subdir.
4367 (let* ((dir (dired-current-directory))
4368 (switch-string
4369 (read-string
4370 "New ls switches for current subdir (must contain -l): "
4371 (dired-make-switches-string
4372 (nth 3 (assoc dir dired-subdir-alist)))))
4373 (switches (dired-make-switches-list switch-string)))
4374 (if (dired-compatible-switches-p switches dired-internal-switches)
4375 (dired-sort-other switches nil dir)
4376 (if (or
4377 (memq 'sort-revert dired-no-confirm)
4378 (y-or-n-p
4379 (format
4380 "Switches %s incompatible with default %s. Revert buffer? "
4381 switch-string
4382 (dired-make-switches-string dired-internal-switches))))
4383 (dired-sort-other switches nil nil)
4384 (error "Switches unchanged. Remain as %s." switch-string)))))
4385 ((eq arg 2)
4386 ;; Set new defaults for subdirs inserted in the future.
4387 (let* ((switch-string
4388 (read-string
4389 "Default ls switches for new subdirs (must contain -l): "
4390 (dired-make-switches-string dired-internal-switches)))
4391 (switches (dired-make-switches-list switch-string))
4392 (alist dired-subdir-alist)
4393 x bad-switches)
4394 (while alist
4395 (setq x (nth 3 (car alist))
4396 alist (cdr alist))
4397 (or (dired-compatible-switches-p x switches)
4398 (member x bad-switches)
4399 (setq bad-switches (cons x bad-switches))))
4400 (if bad-switches
4401 (if (or (memq 'sort-revert dired-no-confirm)
4402 (y-or-n-p
4403 (format
4404 "Switches %s incompatible with %s. Revert buffer? "
4405 switch-string (mapconcat 'dired-make-switches-string
4406 bad-switches ", "))))
4407 (dired-sort-other switches nil nil)
4408 (error "Default switches unchanged. Remain as %s."
4409 (dired-make-switches-string dired-internal-switches)))
4410 (dired-sort-other switches t nil))))
4411 ((or (equal arg '(4)) (eq arg 'date) (eq arg 'name))
4412 ;; Toggle the entire buffer name/data.
4413 (let ((cursor-in-echo-area t)
4414 (switches (copy-sequence dired-internal-switches))
4415 (type (and (symbolp arg) arg))
4416 char)
4417 (while (null type)
4418 (message "Sort entire buffer according to (n)ame or (d)ate? ")
4419 (setq char (read-char)
4420 type (cond
4421 ((char-equal char ?d) 'date)
4422 ((char-equal char ?n) 'name)
4423 (t (message "Type one of n or d.") (sit-for 1) nil))))
4424 (mapcar (function
4425 (lambda (x)
4426 (setq switches
4427 (delq (car x) switches))))
4428 dired-sort-type-alist)
4429 (dired-sort-other
4430 (if (eq type 'date) (cons ?t switches) switches) nil nil)))
4431 ((equal arg '(16))
4432 ;; Edit the switches for the entire buffer.
4433 (dired-sort-other
4434 (dired-make-switches-list
4435 (read-string
4436 "Change ls switches for entire buffer to (must contain -l): "
4437 (dired-make-switches-string dired-internal-switches)))
4438 nil nil))
4439 (t
4440 ;; No idea what's going on.
4441 (error
4442 "Invalid prefix. See %s dired-sort-toggle-or-edit."
4443 (substitute-command-keys
4444 (if (featurep 'ehelp)
4445 "\\[electric-describe-function]"
4446 "\\[describe-function]"))))))
4447
4448 (defun dired-sort-other (switches &optional no-revert subdir)
4449 ;; Specify new ls SWITCHES for current dired buffer.
4450 ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
4451 ;; If subdir is non-nil, only changes the switches for the
4452 ;; sudirectory.
4453 (if subdir
4454 (let ((elt (assoc subdir dired-subdir-alist)))
4455 (if elt (setcar (nthcdr 3 elt) switches)))
4456 (setq dired-internal-switches switches))
4457 (or no-revert
4458 (cond
4459
4460 (subdir
4461 (let ((ofile (dired-get-filename nil t))
4462 (opoint (point)))
4463 (message "Relisting %s..." subdir)
4464 (dired-insert-subdir subdir switches)
4465 (message "Relisting %s... done" subdir)
4466 (or (and ofile (dired-goto-file ofile)) (goto-char opoint))))
4467
4468 ((memq ?R switches)
4469 ;; We are replacing a buffer with a giant recursive listing.
4470 (let ((opoint (point))
4471 (ofile (dired-get-filename nil t))
4472 (hidden-subdirs (dired-remember-hidden))
4473 (mark-alist (dired-remember-marks (point-min) (point-max)))
4474 (kill-files-p (save-excursion
4475 (goto-char (point))
4476 (search-forward
4477 (concat (char-to-string ?\r)
4478 (regexp-quote
4479 (char-to-string
4480 dired-kill-marker-char)))
4481 nil t)))
4482 (omit-files (nth 2 (nth (1- (length dired-subdir-alist))
4483 dired-subdir-alist)))
4484 buffer-read-only)
4485 (dired-readin dired-directory (current-buffer)
4486 (or (consp dired-directory)
4487 (null (file-directory-p dired-directory))))
4488 (dired-mark-remembered mark-alist) ; mark files that were marked
4489 (if kill-files-p (dired-do-hide dired-kill-marker-char))
4490 (if omit-files
4491 (dired-omit-expunge nil t))
4492 ;; hide subdirs that were hidden
4493 (save-excursion
4494 (mapcar (function (lambda (dir)
4495 (if (dired-goto-subdir dir)
4496 (dired-hide-subdir 1))))
4497 hidden-subdirs))
4498 ;; Try to get back to where we were
4499 (or (and ofile (dired-goto-file ofile))
4500 (goto-char opoint))
4501 (dired-move-to-filename)))
4502
4503 (t
4504 ;; Clear all switches in the subdir alist
4505 (setq dired-subdir-alist
4506 (mapcar (function
4507 (lambda (x)
4508 (setcar (nthcdr 3 x) nil)
4509 x))
4510 dired-subdir-alist))
4511 (revert-buffer nil t))))
4512 (dired-update-mode-line t))
4513
4514 (defun dired-compatible-switches-p (list1 list2)
4515 ;; Returns t if list1 and list2 are allowed as switches in the same
4516 ;; dired buffer.
4517 (and (eq (null (or (memq ?l list1) (memq ?o list1) (memq ?g list1)))
4518 (null (or (memq ?l list2) (memq ?o list2) (memq ?g list2))))
4519 (eq (null (memq ?F list1)) (null (memq ?F list2)))
4520 (eq (null (memq ?p list1)) (null (memq ?p list2)))
4521 (eq (null (memq ?b list1)) (null (memq ?b list2)))))
4522
4523 (defun dired-check-ls-l (&optional switches)
4524 ;; Check for long-style listings
4525 (let ((switches (or switches dired-internal-switches)))
4526 (or (memq ?l switches) (memq ?o switches) (memq ?g switches)
4527 (error "Dired needs -l, -o, or -g in ls switches"))))
4528
4529
4530 ;;;; --------------------------------------------------------------
4531 ;;;; Creating new files.
4532 ;;;; --------------------------------------------------------------
4533 ;;;
4534 ;;; The dired-create-files paradigm is used for copying, renaming,
4535 ;;; compressing, and making hard and soft links.
4536
4537 (defun dired-file-marker (file)
4538 ;; Return FILE's marker, or nil if unmarked.
4539 (save-excursion
4540 (and (dired-goto-file file)
4541 (progn
4542 (skip-chars-backward "^\n\r")
4543 (and (not (= ?\040 (following-char)))
4544 (following-char))))))
4545
4546 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
4547 (defun dired-create-files (file-creator operation fn-list name-constructor
4548 &optional marker-char query
4549 implicit-to)
4550 ;; Create a new file for each from a list of existing files. The user
4551 ;; is queried, dired buffers are updated, and at the end a success or
4552 ;; failure message is displayed
4553
4554 ;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
4555 ;; It is called for each file and must create newfile, the entry of
4556 ;; which will be added. The user will be queried if the file already
4557 ;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
4558 ;; rename), it is FILE-CREATOR's responsibility to update dired
4559 ;; buffers. FILE-CREATOR must abort by signalling a file-error if it
4560 ;; could not create newfile. The error is caught and logged.
4561
4562 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
4563 ;; operation performed. It is used for error logging.
4564
4565 ;; FN-LIST is the list of files to copy (full absolute pathnames).
4566
4567 ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
4568 ;; skip. If it skips files, it is supposed to tell why (using dired-log).
4569
4570 ;; Optional MARKER-CHAR is a character with which to mark every
4571 ;; newfile's entry, or t to use the current marker character if the
4572 ;; oldfile was marked.
4573
4574 ;; QUERY is a function to use to prompt the user about creating a file.
4575 ;; It accepts two args, the from and to files,
4576 ;; and must return nil or t. If QUERY is nil, then no user
4577 ;; confirmation will be requested.
4578
4579 ;; If IMPLICIT-TO is non-nil, then the file constructor does not take
4580 ;; a to-file arg. e.g. compress.
4581
4582 (let ((success-count 0)
4583 (total (length fn-list))
4584 failures skipped overwrite-query)
4585 ;; Fluid vars used for storing responses of previous queries must be
4586 ;; initialized.
4587 (dired-save-excursion
4588 (setq dired-overwrite-backup-query nil
4589 dired-file-creator-query nil)
4590 (mapcar
4591 (function
4592 (lambda (from)
4593 (let ((to (funcall name-constructor from)))
4594 (if to
4595 (if (equal to from)
4596 (progn
4597 (dired-log (buffer-name (current-buffer))
4598 "Cannot %s to same file: %s\n"
4599 (downcase operation) from)
4600 (setq skipped (cons (dired-make-relative from) skipped)))
4601 (if (or (null query)
4602 (funcall query from to))
4603 (let* ((overwrite (let (jka-compr-enabled)
4604 ;; Don't let jka-compr fool us.
4605 (file-exists-p to)))
4606 ;; for dired-handle-overwrite
4607 (dired-overwrite-confirmed
4608 (and overwrite
4609 (let ((help-form '(format "\
4610 Type SPC or `y' to overwrite file `%s',
4611 DEL or `n' to skip to next,
4612 ESC or `q' to not overwrite any of the remaining files,
4613 `!' to overwrite all remaining files with no more questions." to)))
4614 (dired-query 'overwrite-query
4615 "Overwrite %s?" to))))
4616 ;; must determine if FROM is marked before
4617 ;; file-creator gets a chance to delete it
4618 ;; (in case of a move).
4619 (actual-marker-char
4620 (cond ((integerp marker-char) marker-char)
4621 (marker-char (dired-file-marker from))
4622 (t nil))))
4623 (if (and overwrite (null dired-overwrite-confirmed))
4624 (setq skipped (cons (dired-make-relative from)
4625 skipped))
4626 (condition-case err
4627 (let ((dired-unhandle-add-files
4628 (cons to dired-unhandle-add-files)))
4629 (if implicit-to
4630 (funcall file-creator from
4631 dired-overwrite-confirmed)
4632 (funcall file-creator from to
4633 dired-overwrite-confirmed))
4634 (setq success-count (1+ success-count))
4635 (message "%s: %d of %d"
4636 operation success-count total)
4637 (dired-add-file to actual-marker-char))
4638 (file-error ; FILE-CREATOR aborted
4639 (progn
4640 (setq failures (cons (dired-make-relative from)
4641 failures))
4642 (dired-log (buffer-name (current-buffer))
4643 "%s `%s' to `%s' failed:\n%s\n"
4644 operation from to err))))))
4645 (setq skipped (cons (dired-make-relative from) skipped))))
4646 (setq skipped (cons (dired-make-relative from) skipped))))))
4647 fn-list)
4648 (cond
4649 (failures
4650 (dired-log-summary
4651 (buffer-name (current-buffer))
4652 (format "%s failed for %d of %d file%s"
4653 operation (length failures) total
4654 (dired-plural-s total)) failures))
4655 (skipped
4656 (dired-log-summary
4657 (buffer-name (current-buffer))
4658 (format "%s: %d of %d file%s skipped"
4659 operation (length skipped) total
4660 (dired-plural-s total)) skipped))
4661 (t
4662 (message "%s: %s file%s."
4663 operation success-count (dired-plural-s success-count)))))))
4664
4665 (defun dired-do-create-files (op-symbol file-creator operation arg
4666 &optional marker-char
4667 prompter how-to)
4668 ;; Create a new file for each marked file.
4669 ;; Prompts user for target, which is a directory in which to create
4670 ;; the new files. Target may be a plain file if only one marked
4671 ;; file exists.
4672 ;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
4673 ;; will determine wether pop-ups are appropriate for this OP-SYMBOL.
4674 ;; FILE-CREATOR and OPERATION as in dired-create-files.
4675 ;; ARG as in dired-get-marked-files.
4676 ;; PROMPTER is a function of one-arg, the list of files, to return a prompt
4677 ;; to use for dired-read-file-name. If it is nil, then a default prompt
4678 ;; will be used.
4679 ;; Optional arg MARKER-CHAR as in dired-create-files.
4680 ;; Optional arg HOW-TO determines how to treat target:
4681 ;; If HOW-TO is not given (or nil), and target is a directory, the
4682 ;; file(s) are created inside the target directory. If target
4683 ;; is not a directory, there must be exactly one marked file,
4684 ;; else error.
4685 ;; If HOW-TO is t, then target is not modified. There must be
4686 ;; exactly one marked file, else error.
4687 ;; Else HOW-TO is assumed to be a function of one argument, target,
4688 ;; that looks at target and returns a value for the into-dir
4689 ;; variable. The function dired-into-dir-with-symlinks is provided
4690 ;; for the case (common when creating symlinks) that symbolic
4691 ;; links to directories are not to be considered as directories
4692 ;; (as file-directory-p would if HOW-TO had been nil).
4693
4694 (let* ((fn-list (dired-get-marked-files nil arg))
4695 (fn-count (length fn-list))
4696 (cdir (dired-current-directory))
4697 (target (expand-file-name
4698 (dired-mark-read-file-name
4699 (if prompter
4700 (funcall prompter fn-list)
4701 (concat operation " %s to: "))
4702 (dired-dwim-target-directory)
4703 op-symbol arg (mapcar (function
4704 (lambda (fn)
4705 (dired-make-relative fn cdir t)))
4706 fn-list))))
4707 (into-dir (cond ((null how-to) (file-directory-p target))
4708 ((eq how-to t) nil)
4709 (t (funcall how-to target)))))
4710 (if (and (> fn-count 1)
4711 (not into-dir))
4712 (error "Marked %s: target must be a directory: %s" operation target))
4713 ;; rename-file bombs when moving directories unless we do this:
4714 (or into-dir (setq target (directory-file-name target)))
4715 (dired-create-files
4716 file-creator operation fn-list
4717 (if into-dir ; target is a directory
4718 (list 'lambda '(from)
4719 (list 'expand-file-name '(file-name-nondirectory from) target))
4720 (list 'lambda '(from) target))
4721 marker-char)))
4722
4723 (defun dired-into-dir-with-symlinks (target)
4724 (and (file-directory-p target)
4725 (not (file-symlink-p target))))
4726 ;; This may not always be what you want, especially if target is your
4727 ;; home directory and it happens to be a symbolic link, as is often the
4728 ;; case with NFS and automounters. Or if you want to make symlinks
4729 ;; into directories that themselves are only symlinks, also quite
4730 ;; common.
4731 ;; So we don't use this function as value for HOW-TO in
4732 ;; dired-do-symlink, which has the minor disadvantage of
4733 ;; making links *into* a symlinked-dir, when you really wanted to
4734 ;; *overwrite* that symlink. In that (rare, I guess) case, you'll
4735 ;; just have to remove that symlink by hand before making your marked
4736 ;; symlinks.
4737
4738 (defun dired-handle-overwrite (to)
4739 ;; Save old version of a to be overwritten file TO.
4740 ;; `dired-overwrite-confirmed' and `dired-overwrite-backup-query'
4741 ;; are fluid vars from dired-create-files.
4742 (if (and dired-backup-if-overwrite
4743 dired-overwrite-confirmed
4744 (or (eq 'always dired-backup-if-overwrite)
4745 (dired-query 'dired-overwrite-backup-query
4746 (format "Make backup for existing file `%s'? " to))))
4747 (let ((backup (car (find-backup-file-name to))))
4748 (rename-file to backup 0)))) ; confirm overwrite of old backup
4749
4750 (defun dired-dwim-target-directory ()
4751 ;; Try to guess which target directory the user may want.
4752 ;; If there is a dired buffer displayed in the next window, use
4753 ;; its current subdir, else use current subdir of this dired buffer.
4754 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
4755 (let* ((this-dir (and (eq major-mode 'dired-mode)
4756 (dired-current-directory)))
4757 (dwimmed
4758 (if dired-dwim-target
4759 (let* ((other-buf (window-buffer (next-window)))
4760 (other-dir (save-excursion
4761 (set-buffer other-buf)
4762 (and (eq major-mode 'dired-mode)
4763 (dired-current-directory)))))
4764 (or other-dir this-dir))
4765 this-dir)))
4766 (and dwimmed (dired-abbreviate-file-name dwimmed))))
4767
4768 (defun dired-get-target-directory ()
4769 "Writes a copy of the current subdirectory into an active minibuffer."
4770 (interactive)
4771 (let ((mb (dired-get-active-minibuffer-window)))
4772 (if mb
4773 (let ((dir (dired-current-directory)))
4774 (select-window mb)
4775 (set-buffer (window-buffer mb))
4776 (erase-buffer)
4777 (insert dir))
4778 (error "No active minibuffer"))))
4779
4780 ;;; Copying files
4781
4782 (defun dired-do-copy (&optional arg)
4783 "Copy all marked (or next ARG) files, or copy the current file.
4784 When operating on just the current file, you specify the new name.
4785 When operating on multiple or marked files, you specify a directory
4786 and the files are copied into that directory, retaining the same file names.
4787
4788 A zero prefix argument copies nothing. But it toggles the
4789 variable `dired-copy-preserve-time' (which see)."
4790 (interactive "P")
4791 (if (not (zerop (prefix-numeric-value arg)))
4792 (dired-do-create-files 'copy (function dired-copy-file)
4793 (if dired-copy-preserve-time "Copy [-p]" "Copy")
4794 arg dired-keep-marker-copy)
4795 (setq dired-copy-preserve-time (not dired-copy-preserve-time))
4796 (if dired-copy-preserve-time
4797 (message "Copy will preserve time.")
4798 (message "Copied files will get current date."))))
4799
4800 (defun dired-copy-file (from to ok-flag)
4801 (dired-handle-overwrite to)
4802 (copy-file from to ok-flag dired-copy-preserve-time))
4803
4804 ;;; Renaming/moving files
4805
4806 (defun dired-do-rename (&optional arg)
4807 "Rename current file or all marked (or next ARG) files.
4808 When renaming just the current file, you specify the new name.
4809 When renaming multiple or marked files, you specify a directory.
4810
4811 A zero ARG moves no files but toggles `dired-dwim-target' (which see)."
4812 (interactive "P")
4813 (if (not (zerop (prefix-numeric-value arg)))
4814 (dired-do-create-files 'move (function dired-rename-file)
4815 "Move" arg dired-keep-marker-rename
4816 (function
4817 (lambda (list)
4818 (if (= (length list) 1)
4819 "Rename %s to: "
4820 "Move %s to: "))))
4821 (setq dired-dwim-target (not dired-dwim-target))
4822 (message "dired-dwim-target is %s." (if dired-dwim-target "ON" "OFF"))))
4823
4824 (defun dired-rename-file (from to ok-flag)
4825 (dired-handle-overwrite to)
4826 (let ((insert (assoc (file-name-as-directory from) dired-subdir-alist)))
4827 (rename-file from to ok-flag) ; error is caught in -create-files
4828 ;; Silently rename the visited file of any buffer visiting this file.
4829 (dired-rename-update-buffers from to insert)))
4830
4831 (defun dired-rename-update-buffers (from to &optional insert)
4832 (if (get-file-buffer from)
4833 (save-excursion
4834 (set-buffer (get-file-buffer from))
4835 (let ((modflag (buffer-modified-p)))
4836 (set-visited-file-name to) ; kills write-file-hooks
4837 (set-buffer-modified-p modflag)))
4838 ;; It's a directory. More work to do.
4839 (let ((blist (buffer-list))
4840 (from-dir (file-name-as-directory from))
4841 (to-dir (file-name-as-directory to)))
4842 (save-excursion
4843 (while blist
4844 (set-buffer (car blist))
4845 (setq blist (cdr blist))
4846 (cond
4847 (buffer-file-name
4848 (if (dired-in-this-tree buffer-file-name from-dir)
4849 (let ((modflag (buffer-modified-p)))
4850 (unwind-protect
4851 (set-visited-file-name
4852 (concat to-dir (substring buffer-file-name
4853 (length from-dir))))
4854 (set-buffer-modified-p modflag)))))
4855 (dired-directory
4856 (if (string-equal from-dir (expand-file-name default-directory))
4857 ;; If top level directory was renamed, lots of things
4858 ;; have to be updated.
4859 (progn
4860 (dired-unadvertise from-dir)
4861 (setq default-directory to-dir
4862 dired-directory
4863 ;; Need to beware of wildcards.
4864 (expand-file-name
4865 (file-name-nondirectory dired-directory)
4866 to-dir))
4867 (let ((new-name (file-name-nondirectory
4868 (directory-file-name dired-directory))))
4869 ;; Try to rename buffer, but just leave old name if new
4870 ;; name would already exist (don't try appending "<%d>")
4871 ;; Why? --sandy 19-8-94
4872 (or (get-buffer new-name)
4873 (rename-buffer new-name)))
4874 (dired-advertise))
4875 (and insert
4876 (assoc (file-name-directory (directory-file-name to))
4877 dired-subdir-alist)
4878 (dired-insert-subdir to))))))))))
4879
4880 ;;; Making symbolic links
4881
4882 (defun dired-do-symlink (&optional arg)
4883 "Make symbolic links to current file or all marked (or next ARG) files.
4884 When operating on just the current file, you specify the new name.
4885 When operating on multiple or marked files, you specify a directory
4886 and new symbolic links are made in that directory
4887 with the same names that the files currently have."
4888 (interactive "P")
4889 (dired-do-create-files 'symlink (function make-symbolic-link)
4890 "SymLink" arg dired-keep-marker-symlink))
4891
4892 ;; Relative symlinks:
4893 ;; make-symbolic no longer expands targets (as of at least 18.57),
4894 ;; so the code to call ln has been removed.
4895
4896 (defun dired-do-relsymlink (&optional arg)
4897 "Symlink all marked (or next ARG) files into a directory,
4898 or make a symbolic link to the current file.
4899 This creates relative symbolic links like
4900
4901 foo -> ../bar/foo
4902
4903 not absolute ones like
4904
4905 foo -> /ugly/path/that/may/change/any/day/bar/foo"
4906 (interactive "P")
4907 (dired-do-create-files 'relsymlink (function dired-make-relative-symlink)
4908 "RelSymLink" arg dired-keep-marker-symlink))
4909
4910 (defun dired-make-relative-symlink (target linkname
4911 &optional ok-if-already-exists)
4912 "Make a relative symbolic link pointing to TARGET with name LINKNAME.
4913 Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS
4914 The link is relative (if possible), for example
4915
4916 \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
4917
4918 results in
4919
4920 \"../../tex/bin/foo\" \"/vol/local/bin/foo\""
4921 (interactive
4922 (let ((target (read-string "Make relative symbolic link to file: ")))
4923 (list
4924 target
4925 (read-file-name (format "Make relsymlink to file %s: " target))
4926 0)))
4927 (let* ((target (expand-file-name target))
4928 (linkname (expand-file-name linkname))
4929 (handler (or (find-file-name-handler
4930 linkname 'dired-make-relative-symlink)
4931 (find-file-name-handler
4932 target 'dired-make-relative-symlink))))
4933 (if handler
4934 (funcall handler 'dired-make-relative-symlink target linkname
4935 ok-if-already-exists)
4936 (setq target (directory-file-name target)
4937 linkname (directory-file-name linkname))
4938 (make-symbolic-link
4939 (dired-make-relative target (file-name-directory linkname) t)
4940 linkname ok-if-already-exists))))
4941
4942 ;;; Hard links -- adding names to files
4943
4944 (defun dired-do-hardlink (&optional arg)
4945 "Add names (hard links) current file or all marked (or next ARG) files.
4946 When operating on just the current file, you specify the new name.
4947 When operating on multiple or marked files, you specify a directory
4948 and new hard links are made in that directory
4949 with the same names that the files currently have."
4950 (interactive "P")
4951 (dired-do-create-files 'hardlink (function add-name-to-file)
4952 "HardLink" arg dired-keep-marker-hardlink))
4953
4954
4955 ;;;; ---------------------------------------------------------------
4956 ;;;; Running process on marked files
4957 ;;;; ---------------------------------------------------------------
4958 ;;;
4959 ;;; Commands for shell processes are in dired-shell.el.
4960
4961 ;;; Internal functions for running subprocesses,
4962 ;;; checking and logging of their errors.
4963
4964 (defun dired-call-process (program discard &rest arguments)
4965 ;; Run PROGRAM with output to current buffer unless DISCARD is t.
4966 ;; Remaining arguments are strings passed as command arguments to PROGRAM.
4967 ;; Returns program's exit status, as an integer.
4968 ;; This is a separate function so that efs can redefine it.
4969 (let ((return
4970 (apply 'call-process program nil (not discard) nil arguments)))
4971 (if (and (not (equal shell-file-name program))
4972 (integerp return))
4973 return
4974 ;; Fudge return code by looking for errors in current buffer.
4975 (if (zerop (buffer-size)) 0 1))))
4976
4977 (defun dired-check-process (msg program &rest arguments)
4978 ;; Display MSG while running PROGRAM, and check for output.
4979 ;; Remaining arguments are strings passed as command arguments to PROGRAM.
4980 ;; On error, insert output in a log buffer and return the
4981 ;; offending ARGUMENTS or PROGRAM.
4982 ;; Caller can cons up a list of failed args.
4983 ;; Else returns nil for success.
4984 (let ((err-buffer (get-buffer-create " *dired-check-process output*"))
4985 (dir default-directory))
4986 (message "%s..." msg)
4987 (save-excursion
4988 ;; Get a clean buffer for error output:
4989 (set-buffer err-buffer)
4990 (erase-buffer)
4991 (setq default-directory dir) ; caller's default-directory
4992 (if (not
4993 (eq 0 (apply (function dired-call-process) program nil arguments)))
4994 (progn
4995 (dired-log (buffer-name (current-buffer))
4996 (concat program " " (prin1-to-string arguments) "\n"))
4997 (dired-log (buffer-name (current-buffer)) err-buffer)
4998 (or arguments program t))
4999 (kill-buffer err-buffer)
5000 (message "%s...done" msg)
5001 nil))))
5002
5003 ;;; Changing file attributes
5004
5005 (defun dired-do-chxxx (attribute-name program op-symbol arg)
5006 ;; Change file attributes (mode, group, owner) of marked files and
5007 ;; refresh their file lines.
5008 ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
5009 ;; PROGRAM is the program used to change the attribute.
5010 ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
5011 ;; ARG describes which files to use, like in dired-get-marked-files.
5012 (let* ((files (dired-get-marked-files t arg))
5013 (new-attribute
5014 (dired-mark-read-string
5015 (concat "Change " attribute-name " of %s to: ")
5016 nil op-symbol arg files))
5017 (operation (concat program " " new-attribute))
5018 (failures
5019 (dired-bunch-files 10000 (function dired-check-process)
5020 (list operation program new-attribute)
5021 files)))
5022 (dired-do-redisplay arg);; moves point if ARG is an integer
5023 (if failures
5024 (dired-log-summary (buffer-name (current-buffer))
5025 (format "%s: error" operation) nil))))
5026
5027 (defun dired-do-chmod (&optional arg)
5028 "Change the mode of the marked (or next ARG) files.
5029 This calls chmod, thus symbolic modes like `g+w' are allowed."
5030 (interactive "P")
5031 (dired-do-chxxx "Mode" "chmod" 'chmod arg))
5032
5033 (defun dired-do-chgrp (&optional arg)
5034 "Change the group of the marked (or next ARG) files."
5035 (interactive "P")
5036 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
5037
5038 (defun dired-do-chown (&optional arg)
5039 "Change the owner of the marked (or next ARG) files."
5040 (interactive "P")
5041 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
5042
5043 ;;; Utilities for running processes on marked files.
5044
5045 ;; Process all the files in FILES in batches of a convenient size,
5046 ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
5047 ;; Batches are chosen to need less than MAX chars for the file names,
5048 ;; allowing 3 extra characters of separator per file name.
5049 (defun dired-bunch-files (max function args files)
5050 (let (pending
5051 (pending-length 0)
5052 failures)
5053 ;; Accumulate files as long as they fit in MAX chars,
5054 ;; then process the ones accumulated so far.
5055 (while files
5056 (let* ((thisfile (car files))
5057 (thislength (+ (length thisfile) 3))
5058 (rest (cdr files)))
5059 ;; If we have at least 1 pending file
5060 ;; and this file won't fit in the length limit, process now.
5061 (if (and pending (> (+ thislength pending-length) max))
5062 (setq failures
5063 (nconc (apply function (append args pending))
5064 failures)
5065 pending nil
5066 pending-length 0))
5067 ;; Do (setq pending (cons thisfile pending))
5068 ;; but reuse the cons that was in `files'.
5069 (setcdr files pending)
5070 (setq pending files)
5071 (setq pending-length (+ thislength pending-length))
5072 (setq files rest)))
5073 (nconc (apply function (append args pending))
5074 failures)))
5075
5076
5077 ;;;; ---------------------------------------------------------------
5078 ;;;; Calculating data or properties for marked files.
5079 ;;;; ---------------------------------------------------------------
5080
5081 (defun dired-do-total-size (&optional arg)
5082 "Show total size of all marked (or next ARG) files."
5083 (interactive "P")
5084 (let* ((result (dired-map-over-marks (dired-get-file-size) arg))
5085 (total (apply (function +) result))
5086 (num (length result)))
5087 (message "%d bytes (%d kB) in %s file%s"
5088 total (/ total 1024) num (dired-plural-s num))
5089 total))
5090
5091 (defun dired-get-file-size ()
5092 ;; Returns the file size in bytes of the current file, as an integer.
5093 ;; Assumes that it is on a valid file line. It's the caller's responsibility
5094 ;; to ensure this. Assumes that match 0 for dired-re-month-and-time is
5095 ;; at the end of the file size.
5096 (dired-move-to-filename t)
5097 ;; dired-move-to-filename must leave match-beginning 0 at the start of
5098 ;; the date.
5099 (goto-char (match-beginning 0))
5100 (skip-chars-backward " ")
5101 (string-to-int (buffer-substring (point)
5102 (progn (skip-chars-backward "0-9")
5103 (point)))))
5104
5105 (defun dired-copy-filenames-as-kill (&optional arg)
5106 "Copy names of marked (or next ARG) files into the kill ring.
5107 The names are separated by a space, and may be copied into other buffers
5108 with \\[yank]. The list of names is also stored in the variable
5109 `dired-marked-files' for possible manipulation in the *scratch* buffer.
5110
5111 With a 0 prefix argument, use the pathname relative to the top-level dired
5112 directory for each marked file.
5113
5114 With a prefix \\[universal-argument], use the complete pathname of each
5115 marked file.
5116
5117 With a prefix \\[universal-argument] \\[universal-argument], copy the complete
5118 file line. In this case, the lines are separated by newlines.
5119
5120 If on a subdirectory headerline and no prefix argument given, use the
5121 subdirectory name instead."
5122 (interactive "P")
5123 (let (res)
5124 (cond
5125 ((and (null arg) (setq res (dired-get-subdir)))
5126 (kill-new res)
5127 (message "Copied %s into kill ring." res))
5128 ((equal arg '(16))
5129 (setq dired-marked-files
5130 (dired-map-over-marks
5131 (concat " " ; Don't copy the mark.
5132 (buffer-substring
5133 (progn (beginning-of-line) (1+ (point)))
5134 (progn (skip-chars-forward "^\n\r") (point))))
5135 nil))
5136 (let ((len (length dired-marked-files)))
5137 (kill-new (concat
5138 (mapconcat 'identity dired-marked-files "\n")
5139 "\n"))
5140 (message "Copied %d file line%s into kill ring."
5141 len (dired-plural-s len))))
5142 (t
5143 (setq dired-marked-files
5144 (cond
5145 ((null arg)
5146 (dired-get-marked-files 'no-dir))
5147 ((eq arg 0)
5148 (dired-get-marked-files t))
5149 ((integerp arg)
5150 (dired-get-marked-files 'no-dir arg))
5151 ((equal arg '(4))
5152 (dired-get-marked-files))
5153 (t (error "Invalid prefix %s" arg))))
5154 (let ((len (length dired-marked-files)))
5155 (kill-new (mapconcat 'identity dired-marked-files " "))
5156 (message "Copied %d file name%s into kill ring."
5157 len (dired-plural-s len)))))))
5158
5159
5160 ;;;; -----------------------------------------------------------
5161 ;;;; Killing subdirectories
5162 ;;;; -----------------------------------------------------------
5163 ;;;
5164 ;;; These commands actually remove text from the dired buffer.
5165
5166 (defun dired-kill-subdir (&optional remember-marks tree)
5167 "Remove all lines of current subdirectory.
5168 Lower levels are unaffected. If given a prefix when called interactively,
5169 kills the entire directory tree below the current subdirectory."
5170 ;; With optional REMEMBER-MARKS, return a mark-alist.
5171 (interactive (list nil current-prefix-arg))
5172 (let ((cur-dir (dired-current-directory)))
5173 (if (string-equal cur-dir (expand-file-name default-directory))
5174 (error "Attempt to kill top level directory"))
5175 (if tree
5176 (dired-kill-tree cur-dir remember-marks)
5177 (let ((beg (dired-subdir-min))
5178 (end (dired-subdir-max))
5179 buffer-read-only)
5180 (prog1
5181 (if remember-marks (dired-remember-marks beg end))
5182 (goto-char beg)
5183 (or (bobp) (forward-char -1)) ; gobble separator
5184 (delete-region (point) end)
5185 (dired-unsubdir cur-dir)
5186 (dired-update-mode-line)
5187 (dired-update-mode-line-modified t))))))
5188
5189 (defun dired-kill-tree (dirname &optional remember-marks)
5190 "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
5191 With optional arg REMEMBER-MARKS, return an alist of marked files."
5192 (interactive "DKill tree below directory: ")
5193 (let ((s-alist dired-subdir-alist) dir m-alist)
5194 (while s-alist
5195 (setq dir (car (car s-alist))
5196 s-alist (cdr s-alist))
5197 (if (and (not (string-equal dir dirname))
5198 (dired-in-this-tree dir dirname)
5199 (dired-goto-subdir dir))
5200 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
5201 (dired-update-mode-line)
5202 (dired-update-mode-line-modified t)
5203 m-alist))
5204
5205
5206 ;;;; ------------------------------------------------------------
5207 ;;;; Killing file lines
5208 ;;;; ------------------------------------------------------------
5209 ;;;
5210 ;;; Uses selective diplay, rather than removing lines from the buffer.
5211
5212 (defun dired-do-kill-file-lines (&optional arg)
5213 "Kill all marked file lines, or those indicated by the prefix argument.
5214 Killing file lines means hiding them with selective display. Giving
5215 a zero prefix redisplays all killed file lines."
5216 (interactive "P")
5217 (or selective-display
5218 (error "selective-display must be t for file line killing to work!"))
5219 (if (eq arg 0)
5220 (dired-do-unhide dired-kill-marker-char
5221 "Successfully resuscitated %d file line%s."
5222 dired-keep-marker-kill)
5223 (let ((files
5224 (length
5225 (dired-map-over-marks
5226 (progn
5227 (beginning-of-line)
5228 (subst-char-in-region (1- (point)) (point) ?\n ?\r)
5229 (dired-substitute-marker (point) (following-char)
5230 dired-kill-marker-char)
5231 (dired-update-marker-counters dired-marker-char t)
5232 t)
5233 arg))))
5234 ;; Beware of extreme apparent save-excursion lossage here.
5235 (let ((opoint (point)))
5236 (skip-chars-backward "^\n\r")
5237 (if (= (preceding-char) ?\n)
5238 (goto-char opoint)
5239 (setq opoint (- opoint (point)))
5240 (beginning-of-line)
5241 (skip-chars-forward "^\n\r" (+ (point) opoint))))
5242 (dired-update-mode-line-modified)
5243 (message "Killed %d file line%s." files (dired-plural-s files)))))
5244
5245
5246 ;;;; ----------------------------------------------------------------
5247 ;;;; Omitting files.
5248 ;;;; ----------------------------------------------------------------
5249
5250 ;; Marked files are never omitted.
5251 ;; Adapted from code submitted by:
5252 ;; Michael D. Ernst, mernst@theory.lcs.mit.edu, 1/11/91
5253 ;; Changed to work with selective display by Sandy Rutherford, 13/12/92.
5254 ;; For historical reasons, we still use the term expunge, although nothing
5255 ;; is expunged from the buffer.
5256
5257 (defun dired-omit-toggle (&optional arg)
5258 "Toggle between displaying and omitting files matching
5259 `dired-omit-files-regexp' in the current subdirectory.
5260 With a positive prefix, omits files in the entire tree dired buffer.
5261 With a negative prefix, forces all files in the tree dired buffer to be
5262 displayed."
5263 (interactive "P")
5264 (if arg
5265 (let ((arg (prefix-numeric-value arg)))
5266 (if (>= arg 0)
5267 (dired-omit-expunge nil t)
5268 (dired-do-unhide dired-omit-marker-char "")
5269 (mapcar
5270 (function
5271 (lambda (elt)
5272 (setcar (nthcdr 2 elt) nil)))
5273 dired-subdir-alist)))
5274 (if (dired-current-subdir-omitted-p)
5275 (save-restriction
5276 (narrow-to-region (dired-subdir-min) (dired-subdir-max))
5277 (dired-do-unhide dired-omit-marker-char "")
5278 (setcar (nthcdr 2 (assoc
5279 (dired-current-directory) dired-subdir-alist))
5280 nil)
5281 (setq dired-subdir-omit nil))
5282 (dired-omit-expunge)
5283 (setq dired-subdir-omit t)))
5284 (dired-update-mode-line t))
5285
5286 (defun dired-current-subdir-omitted-p ()
5287 ;; Returns t if the current subdirectory is omited.
5288 (nth 2 (assoc (dired-current-directory) dired-subdir-alist)))
5289
5290 (defun dired-remember-omitted ()
5291 ;; Returns a list of omitted subdirs.
5292 (let ((alist dired-subdir-alist)
5293 result elt)
5294 (while alist
5295 (setq elt (car alist)
5296 alist (cdr alist))
5297 (if (nth 2 elt)
5298 (setq result (cons (car elt) result))))
5299 result))
5300
5301 (defun dired-omit-expunge (&optional regexp full-buffer)
5302 ;; Hides all unmarked files matching REGEXP.
5303 ;; If REGEXP is nil or not specified, uses `dired-omit-files-regexp',
5304 ;; and also omits filenames ending in `dired-omit-extensions'.
5305 ;; If REGEXP is the empty string, this function is a no-op.
5306 (let ((omit-re (or regexp (dired-omit-regexp)))
5307 (alist dired-subdir-alist)
5308 elt min)
5309 (if (null omit-re)
5310 0
5311 (if full-buffer
5312 (prog1
5313 (dired-omit-region (point-min) (point-max) omit-re)
5314 ;; Set omit property in dired-subdir-alist
5315 (while alist
5316 (setq elt (car alist)
5317 min (dired-get-subdir-min elt)
5318 alist (cdr alist))
5319 (if (and (<= (point-min) min) (>= (point-max) min))
5320 (setcar (nthcdr 2 elt) t))))
5321 (prog1
5322 (dired-omit-region (dired-subdir-min) (dired-subdir-max) omit-re)
5323 (setcar
5324 (nthcdr 2 (assoc (dired-current-directory)
5325 dired-subdir-alist))
5326 t))))))
5327
5328 (defun dired-omit-region (start end regexp)
5329 ;; Omits files matching regexp in region. Returns count.
5330 (save-restriction
5331 (narrow-to-region start end)
5332 (let ((hidden-subdirs (dired-remember-hidden))
5333 buffer-read-only count)
5334 (or selective-display
5335 (error "selective-display must be t for file omission to work!"))
5336 (dired-omit-unhide-region start end)
5337 (let ((dired-marker-char dired-omit-marker-char)
5338 ;; since all subdirs are now unhidden, this fakes
5339 ;; dired-move-to-end-of-filename into working faster
5340 (selective-display nil))
5341 (or dired-omit-silent
5342 dired-in-query (message "Omitting..."))
5343 (if (dired-mark-unmarked-files regexp nil nil 'no-dir)
5344 (setq count (dired-do-hide
5345 dired-marker-char
5346 (and (memq dired-omit-silent '(nil 0))
5347 (not dired-in-query)
5348 "Omitted %d line%s.")))
5349 (or dired-omit-silent dired-in-query
5350 (message "(Nothing to omit)"))))
5351 (save-excursion ;hide subdirs that were hidden
5352 (mapcar (function (lambda (dir)
5353 (if (dired-goto-subdir dir)
5354 (dired-hide-subdir 1))))
5355 hidden-subdirs))
5356 count)))
5357
5358 (defun dired-omit-unhide-region (beg end)
5359 ;; Unhides hidden, but not marked files in the region.
5360 (save-excursion
5361 (save-restriction
5362 (narrow-to-region beg end)
5363 (goto-char (point-min))
5364 (while (search-forward "\r" nil t)
5365 (and (char-equal (following-char) ?\ )
5366 (subst-char-in-region (1- (point)) (point) ?\r ?\n))))))
5367
5368 (defun dired-do-unhide (char &optional fmt marker)
5369 ;; Unhides files marked with CHAR. Optional FMT is a message
5370 ;; to be displayed. Note that after unhiding, we will need to re-hide
5371 ;; files belonging to hidden subdirs.
5372 (save-excursion
5373 (goto-char (point-min))
5374 (let ((count 0)
5375 (string (concat "\r" (char-to-string char)))
5376 (hidden-subdirs (dired-remember-hidden))
5377 (new (if marker (concat "\n" (char-to-string marker)) "\n "))
5378 buffer-read-only)
5379 (while (search-forward string nil t)
5380 (replace-match new)
5381 (setq count (1+ count)))
5382 (or (equal "" fmt)
5383 (message (or fmt "Unhid %d line%s.") count (dired-plural-s count)))
5384 (goto-char (point-min))
5385 (mapcar (function (lambda (dir)
5386 (if (dired-goto-subdir dir)
5387 (dired-hide-subdir 1 t))))
5388 hidden-subdirs)
5389 (if marker (dired-update-mode-line-modified t))
5390 count)))
5391
5392 (defun dired-do-hide (char &optional fmt)
5393 ;; Hides files marked with CHAR. Otional FMT is a message
5394 ;; to be displayed. FMT is a format string taking args the number
5395 ;; of hidden file lines, and dired-plural-s.
5396 (save-excursion
5397 (goto-char (point-min))
5398 (let ((count 0)
5399 (string (concat "\n" (char-to-string char)))
5400 buffer-read-only)
5401 (while (search-forward string nil t)
5402 (subst-char-in-region (match-beginning 0)
5403 (1+ (match-beginning 0)) ?\n ?\r t)
5404 (setq count (1+ count)))
5405 (if fmt
5406 (message fmt count (dired-plural-s count)))
5407 count)))
5408
5409 (defun dired-omit-regexp ()
5410 (let (rgxp)
5411 (if dired-omit-extensions
5412 (setq rgxp (concat
5413 ".\\("
5414 (mapconcat 'regexp-quote dired-omit-extensions "\\|")
5415 "\\)$")))
5416 (if dired-omit-regexps
5417 (setq rgxp
5418 (concat
5419 rgxp
5420 (and rgxp "\\|")
5421 (mapconcat 'identity dired-omit-regexps "\\|"))))
5422 rgxp))
5423
5424 (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
5425 ;; Marks unmarked files matching REGEXP, displaying MSG.
5426 ;; REGEXP is matched against the complete pathname, unless localp is
5427 ;; specified.
5428 ;; Does not re-mark files which already have a mark.
5429 ;; Returns t if any work was done, nil otherwise.
5430 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char))
5431 fn)
5432 (dired-mark-if
5433 (and
5434 ;; not already marked
5435 (eq (following-char) ?\ )
5436 ;; uninteresting
5437 (setq fn (dired-get-filename localp t))
5438 (string-match regexp fn))
5439 msg)))
5440
5441 (defun dired-add-omit-regexp (rgxp &optional how)
5442 "Adds a new regular expression to the list of omit regular expresions.
5443 With a non-zero numeric prefix argument, deletes a regular expresion from
5444 the list.
5445
5446 With a prefix argument \\[universal-argument], adds a new extension to
5447 the list of file name extensions omitted.
5448 With a prefix argument \\[universal-argument] \\[universal-argument], deletes
5449 a file name extension from the list.
5450
5451 With a prefix 0, reports on the current omit regular expressions and
5452 extensions."
5453 (interactive
5454 (list
5455 (cond
5456 ((null current-prefix-arg)
5457 (read-string "New omit regular expression: "))
5458 ((equal '(4) current-prefix-arg)
5459 (read-string "New omit extension (\".\" is not implicit): "))
5460 ((equal '(16) current-prefix-arg)
5461 (completing-read
5462 "Remove from omit extensions (type SPACE for options): "
5463 (mapcar 'list dired-omit-extensions) nil t))
5464 ((eq 0 current-prefix-arg)
5465 nil)
5466 (t
5467 (completing-read
5468 "Remove from omit regexps (type SPACE for options): "
5469 (mapcar 'list dired-omit-regexps) nil t)))
5470 current-prefix-arg))
5471 (let (remove)
5472 (cond
5473 ((null how)
5474 (if (member rgxp dired-omit-regexps)
5475 (progn
5476 (describe-variable 'dired-omit-regexps)
5477 (error "%s is already included in the list." rgxp))
5478 (setq dired-omit-regexps (cons rgxp dired-omit-regexps))))
5479 ((equal how '(4))
5480 (if (member rgxp dired-omit-extensions)
5481 (progn
5482 (describe-variable 'dired-omit-extensions)
5483 (error "%s is already included in list." rgxp))
5484 (setq dired-omit-extensions (cons rgxp dired-omit-extensions))))
5485 ((equal how '(16))
5486 (let ((tail (member rgxp dired-omit-extensions)))
5487 (if tail
5488 (setq dired-omit-extensions
5489 (delq (car tail) dired-omit-extensions)
5490 remove t)
5491 (setq remove 'ignore))))
5492 ((eq 0 how)
5493 (setq remove 'ignore)
5494 (if (featurep 'ehelp)
5495 (with-electric-help
5496 (function
5497 (lambda ()
5498 (princ "Omit extensions (dired-omit-extensions <V>):\n")
5499 (dired-format-columns-of-files dired-omit-extensions)
5500 (princ "\n")
5501 (princ "Omit regular expressions (dired-omit-regexps <V>):\n")
5502 (dired-format-columns-of-files dired-omit-regexps)
5503 nil)))
5504 (with-output-to-temp-buffer "*Help*"
5505 (princ "Omit extensions (dired-omit-extensions <V>):\n")
5506 (dired-format-columns-of-files dired-omit-extensions)
5507 (princ "\n")
5508 (princ "Omit regular expressions (dired-omit-regexps <V>):\n")
5509 (dired-format-columns-of-files dired-omit-regexps)
5510 (print-help-return-message))))
5511 (t
5512 (let ((tail (member rgxp dired-omit-regexps)))
5513 (if tail
5514 (setq dired-omit-regexps (delq (car tail) dired-omit-regexps)
5515 remove t)
5516 (setq remove 'ignore)))))
5517 (or (eq remove 'ignore)
5518 (save-excursion
5519 (mapcar
5520 (function
5521 (lambda (dir)
5522 (if (dired-goto-subdir dir)
5523 (progn
5524 (if remove
5525 (save-restriction
5526 (narrow-to-region
5527 (dired-subdir-min) (dired-subdir-max))
5528 (dired-do-unhide dired-omit-marker-char "")))
5529 (dired-omit-expunge)))))
5530 (dired-remember-omitted))))))
5531
5532
5533
5534 ;;;; ----------------------------------------------------------------
5535 ;;;; Directory hiding.
5536 ;;;; ----------------------------------------------------------------
5537 ;;;
5538 ;;; To indicate a hidden subdir, we actually insert "..." in the buffer.
5539 ;;; Aside from giving the look of ellipses (even though
5540 ;;; selective-display-ellipses is nil), it allows us to tell the difference
5541 ;;; between a dir with a single omitted file, and a hidden subdir with one
5542 ;;; file.
5543
5544 (defun dired-subdir-hidden-p (dir)
5545 (save-excursion
5546 (and selective-display
5547 (dired-goto-subdir dir)
5548 (looking-at "\\.\\.\\.\r"))))
5549
5550 (defun dired-unhide-subdir ()
5551 (let (buffer-read-only)
5552 (goto-char (dired-subdir-min))
5553 (skip-chars-forward "^\n\r")
5554 (skip-chars-backward "." (- (point) 3))
5555 (if (looking-at "\\.\\.\\.\r") (delete-char 4))
5556 (dired-omit-unhide-region (point) (dired-subdir-max))))
5557
5558 (defun dired-hide-check ()
5559 (or selective-display
5560 (error "selective-display must be t for subdir hiding to work!")))
5561
5562 (defun dired-hide-subdir (arg &optional really)
5563 "Hide or unhide the current subdirectory and move to next directory.
5564 Optional prefix arg is a repeat factor.
5565 Use \\[dired-hide-all] to (un)hide all directories.
5566 With the optional argument REALLY, we always hide
5567 the subdir, regardless of dired-subdir-hidden-p."
5568 ;; The arg REALLY is needed because when we unhide
5569 ;; omitted files in a hidden subdir, we want to
5570 ;; re-hide the subdir, regardless of whether dired
5571 ;; thinks it's already hidden.
5572 (interactive "p")
5573 (dired-hide-check)
5574 (dired-save-excursion
5575 (while (>= (setq arg (1- arg)) 0)
5576 (let* ((cur-dir (dired-current-directory))
5577 (hidden-p (and (null really)
5578 (dired-subdir-hidden-p cur-dir)))
5579 (elt (assoc cur-dir dired-subdir-alist))
5580 (end-pos (1- (dired-get-subdir-max elt)))
5581 buffer-read-only)
5582 ;; keep header line visible, hide rest
5583 (goto-char (dired-get-subdir-min elt))
5584 (skip-chars-forward "^\n\r")
5585 (skip-chars-backward "." (- (point) 3))
5586 (if hidden-p
5587 (progn
5588 (if (looking-at "\\.\\.\\.\r")
5589 (progn
5590 (delete-char 3)
5591 (setq end-pos (- end-pos 3))))
5592 (dired-omit-unhide-region (point) end-pos))
5593 (if (looking-at "\\.\\.\\.\r")
5594 (goto-char (match-end 0))
5595 (insert "...")
5596 (setq end-pos (+ end-pos 3)))
5597 (subst-char-in-region (point) end-pos ?\n ?\r)))
5598 (dired-next-subdir 1 t))))
5599
5600 (defun dired-hide-all (arg)
5601 "Hide all subdirectories, leaving only their header lines.
5602 If there is already something hidden, make everything visible again.
5603 Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
5604 (interactive "P")
5605 (dired-hide-check)
5606 (let (buffer-read-only)
5607 (dired-save-excursion
5608 (if (let ((alist dired-subdir-alist)
5609 (hidden nil))
5610 (while (and alist (null hidden))
5611 (setq hidden (dired-subdir-hidden-p (car (car alist)))
5612 alist (cdr alist)))
5613 hidden)
5614 ;; unhide
5615 (let ((alist dired-subdir-alist))
5616 (while alist
5617 (goto-char (dired-get-subdir-min (car alist)))
5618 (skip-chars-forward "^\n\r")
5619 (delete-region (point) (progn (skip-chars-backward ".") (point)))
5620 (setq alist (cdr alist)))
5621 (dired-omit-unhide-region (point-min) (point-max)))
5622 ;; hide
5623 (let ((alist dired-subdir-alist))
5624 (while alist
5625 (dired-goto-subdir (car (car alist)))
5626 (dired-hide-subdir 1 t)
5627 (setq alist (cdr alist))))))))
5628
5629
5630 ;;;; -----------------------------------------------------------------
5631 ;;;; Automatic dired buffer maintenance.
5632 ;;;; -----------------------------------------------------------------
5633 ;;;
5634 ;;; Keeping Dired buffers in sync with the filesystem and with each
5635 ;;; other.
5636 ;;; When used with efs on remote directories, buffer maintainence is
5637 ;;; done asynch.
5638
5639 (defun dired-buffers-for-dir (dir-or-list &optional check-wildcard)
5640 ;; Return a list of buffers that dired DIR-OR-LIST
5641 ;; (top level or in-situ subdir).
5642 ;; The list is in reverse order of buffer creation, most recent last.
5643 ;; As a side effect, killed dired buffers for DIR are removed from
5644 ;; dired-buffers. If DIR-OR-LIST is a wildcard or list, returns any
5645 ;; dired buffers for which DIR-OR-LIST is equal to `dired-directory'.
5646 ;; If check-wildcard is non-nil, only returns buffers which contain dir-or-list
5647 ;; exactly, including the wildcard part.
5648 (let ((alist dired-buffers)
5649 (as-dir (and (stringp dir-or-list)
5650 (file-name-as-directory dir-or-list)))
5651 result buff elt)
5652 (while alist
5653 (setq buff (cdr (setq elt (car alist)))
5654 alist (cdr alist))
5655 ;; dired-in-this-tree is not fast. It doesn't pay to use this to check
5656 ;; whether the buffer is a good candidate.
5657 (if (buffer-name buff)
5658 (save-excursion
5659 (set-buffer buff)
5660 (if (or (equal dir-or-list dired-directory) ; the wildcard case.
5661 (and as-dir
5662 (not (and check-wildcard
5663 (string-equal
5664 as-dir
5665 (expand-file-name default-directory))))
5666 (assoc as-dir dired-subdir-alist)))
5667 (setq result (cons buff result))))
5668 ;; else buffer is killed - clean up:
5669 (setq dired-buffers (delq elt dired-buffers))))
5670 (or dired-buffers (dired-remove-from-file-name-handler-alist))
5671 result))
5672
5673 (defun dired-advertise ()
5674 ;; Advertise in variable `dired-buffers' that we dired `default-directory'.
5675 ;; With wildcards we actually advertise too much.
5676 ;; Also makes sure that we are installed in the file-name-handler-alist
5677 (prog1
5678 (let ((ddir (expand-file-name default-directory)))
5679 (if (memq (current-buffer) (dired-buffers-for-dir ddir))
5680 t ; we have already advertised ourselves
5681 (setq dired-buffers
5682 (cons (cons ddir (current-buffer))
5683 dired-buffers))))
5684 ;; Do this last, otherwise the call to dired-buffers-for-dir will
5685 ;; remove dired-handler-fn from the file-name-handler-alist.
5686 ;; Strictly speaking, we only need to do this in th else branch of
5687 ;; the if statement. We do it unconditionally as a sanity check.
5688 (dired-check-file-name-handler-alist)))
5689
5690 (defun dired-unadvertise (dir)
5691 ;; Remove DIR from the buffer alist in variable dired-buffers.
5692 ;; This has the effect of removing any buffer whose main directory is DIR.
5693 ;; It does not affect buffers in which DIR is a subdir.
5694 ;; Removing is also done as a side-effect in dired-buffer-for-dir.
5695 (setq dired-buffers
5696 (delq (assoc dir dired-buffers) dired-buffers))
5697 ;; If there are no more dired buffers, we are no longer needed in the
5698 ;; file-name-handler-alist.
5699 (or dired-buffers (dired-remove-from-file-name-handler-alist)))
5700
5701 (defun dired-unadvertise-current-buffer ()
5702 ;; Remove all references to the current buffer in dired-buffers.
5703 (setq dired-buffers
5704 (delq nil
5705 (mapcar
5706 (function
5707 (lambda (x)
5708 (and (not (eq (current-buffer) (cdr x))) x)))
5709 dired-buffers))))
5710
5711 (defun dired-fun-in-all-buffers (directory fun &rest args)
5712 ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
5713 ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
5714 (let* ((buf-list (dired-buffers-for-dir directory))
5715 (obuf (current-buffer))
5716 (owin (selected-window))
5717 (win owin)
5718 buf windows success-list)
5719 (if buf-list
5720 (unwind-protect
5721 (progn
5722 (while (not (eq (setq win (next-window win)) owin))
5723 (and (memq (setq buf (window-buffer win)) buf-list)
5724 (progn
5725 (set-buffer buf)
5726 (= (point) (window-point win)))
5727 (setq windows (cons win windows))))
5728 (while buf-list
5729 (setq buf (car buf-list)
5730 buf-list (cdr buf-list))
5731 (set-buffer buf)
5732 (if (apply fun args)
5733 (setq success-list (cons (buffer-name buf) success-list))))
5734 ;; dired-save-excursion prevents lossage of save-excursion
5735 ;; for point. However, if dired buffers are displayed in
5736 ;; other windows, the setting of window-point loses, and
5737 ;; drags the point with it. This should fix this.
5738 (while windows
5739 (condition-case nil
5740 (progn
5741 (set-buffer (window-buffer (setq win (car windows))))
5742 (set-window-point win (point)))
5743 (error nil))
5744 (setq windows (cdr windows))))
5745 (set-buffer obuf)))
5746 success-list))
5747
5748 (defun dired-find-file-place (subdir file)
5749 ;; Finds a position to insert in SUBDIR FILE. If it can't find SUBDIR,
5750 ;; returns nil.
5751 (let ((sort (dired-sort-type dired-internal-switches))
5752 (rev (memq ?r (nth 3 (assoc subdir dired-subdir-alist)))))
5753 (cond
5754 ((eq sort 'name)
5755 (if (dired-goto-subdir subdir)
5756 (let ((max (dired-subdir-max))
5757 start end found)
5758 (if (dired-goto-next-file)
5759 (progn
5760 (skip-chars-forward "^\n\r")
5761 (setq start (point))
5762 (goto-char (setq end max))
5763 (forward-char -1)
5764 (skip-chars-backward "^\n\r")
5765 ;; This loop must find a file. At the very least, it will
5766 ;; find the one found previously.
5767 (while (not found)
5768 (if (save-excursion (dired-move-to-filename nil (point)))
5769 (setq found t)
5770 (setq end (point))
5771 (forward-char -1)
5772 (skip-chars-backward "^\n\r")))
5773 (if rev
5774 (while (< start end)
5775 (goto-char (/ (+ start end) 2))
5776 (if (dired-file-name-lessp
5777 (or (dired-get-filename 'no-dir t)
5778 (error
5779 "Error in dired-find-file-place"))
5780 file)
5781 (setq end (progn
5782 (skip-chars-backward "^\n\r")
5783 (point)))
5784 (setq start (progn
5785 (skip-chars-forward "^\n\r")
5786 (forward-char 1)
5787 (skip-chars-forward "^\n\r")
5788 (point)))))
5789 (while (< start end)
5790 (goto-char (/ (+ start end) 2))
5791 (if (dired-file-name-lessp
5792 file
5793 (or (dired-get-filename 'no-dir t)
5794 (error
5795 "Error in dired-find-file-place")))
5796 (setq end (progn
5797 (skip-chars-backward "^\n\r")
5798 (point)))
5799 (setq start (progn
5800 (skip-chars-forward "^\n\r")
5801 (forward-char 1)
5802 (skip-chars-forward "^\n\r")
5803 (point))))))
5804 (goto-char end))
5805 (goto-char max))
5806 t)))
5807 ((eq sort 'date)
5808 (if (dired-goto-subdir subdir)
5809 (if rev
5810 (goto-char (dired-subdir-max))
5811 (dired-goto-next-file)
5812 t)))
5813 ;; Put in support for other sorting types.
5814 (t
5815 (if (string-equal (dired-current-directory) subdir)
5816 (progn
5817 ;; We are already where we should be, except when
5818 ;; point is before the subdir line or its total line.
5819 (or (save-excursion (beginning-of-line) (dired-move-to-filename))
5820 (dired-goto-next-nontrivial-file)) ; in the header somewhere
5821 t) ; return t, for found.
5822 (if (dired-goto-subdir subdir)
5823 (progn
5824 (dired-goto-next-nontrivial-file)
5825 t)))))))
5826
5827 (defun dired-add-entry (filename &optional marker-char inplace)
5828 ;; Add a new entry for FILENAME, optionally marking it
5829 ;; with MARKER-CHAR (a character, else dired-marker-char is used).
5830 ;; Hidden subdirs are exposed if a file is added there.
5831 ;;
5832 ;; This function now adds the new entry at the END of the previous line,
5833 ;; not the beginning of the current line.
5834 ;; Logically, we now think of the `newline' associated
5835 ;; with a fileline, as the one at the beginning of the line, not the end.
5836 ;; This makes it easier to keep track of omitted files.
5837 ;;
5838 ;; Uses dired-save-excursion, so that it doesn't move the
5839 ;; point around. Especially important when it runs asynch.
5840 ;;
5841 ;; If there is already an entry, delete the existing one before adding a
5842 ;; new one. In this case, doesn't remember its mark. Use
5843 ;; dired-update-file-line for that.
5844 ;;
5845 ;; If INPLACE eq 'relist, then the new entry is put in the
5846 ;; same place as the old, if there was an old entry.
5847 ;; If INPLACE is t, then the file entry is put on the line
5848 ;; currently containing the point. Otherwise, dired-find-file-place
5849 ;; attempts to determine where to put the file.
5850
5851 (setq filename (directory-file-name filename))
5852 (dired-save-excursion
5853 (let ((oentry (save-excursion (dired-goto-file filename)))
5854 (directory (file-name-directory filename))
5855 (file-nodir (file-name-nondirectory filename))
5856 buffer-read-only)
5857 (if oentry
5858 ;; Remove old entry
5859 (let ((opoint (point)))
5860 (goto-char oentry)
5861 (delete-region (save-excursion
5862 (skip-chars-backward "^\r\n")
5863 (dired-update-marker-counters (following-char) t)
5864 (1- (point)))
5865 (progn
5866 (skip-chars-forward "^\r\n")
5867 (point)))
5868 ;; Move to right place to replace deleted line.
5869 (cond ((eq inplace 'relist) (forward-char 1))
5870 ((eq inplace t) (goto-char opoint)))
5871 (dired-update-mode-line-modified)))
5872 (if (or (eq inplace t)
5873 (and oentry (eq inplace 'relist))
5874 ;; Tries to move the point to the right place.
5875 ;; Returns t on success.
5876 (dired-find-file-place directory file-nodir))
5877 (let ((switches (dired-make-switches-string
5878 (cons ?d dired-internal-switches)))
5879 b-of-l)
5880 ;; Bind marker-char now, in case we are working asynch and
5881 ;; dired-marker-char changes in the meantime.
5882 (if (and marker-char (not (integerp marker-char)))
5883 (setq marker-char dired-marker-char))
5884 ;; since we insert at the end of a line,
5885 ;; backup to the end of the previous line.
5886 (skip-chars-backward "^\n\r")
5887 (forward-char -1)
5888 (setq b-of-l (point))
5889 (if (and (featurep 'efs-dired) efs-dired-host-type)
5890 ;; insert asynch
5891 ;; we call the efs version explicitly here,
5892 ;; rather than let the handler-alist work for us
5893 ;; because we want to pass extra args.
5894 ;; Is there a cleaner way to do this?
5895 (efs-insert-directory filename ; don't expand `.' !
5896 switches nil nil
5897 t ; nowait
5898 marker-char)
5899 (let ((insert-directory-program dired-ls-program))
5900 (insert-directory filename switches nil nil))
5901 (dired-after-add-entry b-of-l marker-char))
5902 (if dired-verify-modtimes
5903 (dired-set-file-modtime directory dired-subdir-alist))
5904 t))))) ; return t on success, else nil.
5905
5906 (defun dired-after-add-entry (start marker-char)
5907 ;; Does the cleanup of a dired entry after listing it.
5908 ;; START is the start of the new listing-line.
5909 ;; This is a separate function for the sake of efs.
5910 (save-excursion
5911 (goto-char start)
5912 ;; we make sure that the new line is bracketted by new-lines
5913 ;; so the user doesn't need to use voodoo in the
5914 ;; after-readin-hook.
5915 (insert ?\n)
5916 (dired-add-entry-do-indentation marker-char)
5917 (let* ((beg (dired-manual-move-to-filename t))
5918 ;; error for strange output
5919 (end (dired-manual-move-to-end-of-filename))
5920 (filename (buffer-substring beg end)))
5921 ;; We want to have the non-directory part only.
5922 (delete-region beg end)
5923 ;; Any markers pointing to the beginning of the filename, will
5924 ;; still point there after this insertion. Should keep
5925 ;; save-excursion from losing.
5926 (setq beg (point))
5927 (insert (file-name-nondirectory filename))
5928 (dired-insert-set-properties beg (point))
5929 (dired-move-to-filename))
5930 ;; The subdir-alist is not affected so we can run it right now.
5931 (let ((omit (dired-current-subdir-omitted-p))
5932 (hide (dired-subdir-hidden-p (dired-current-directory))))
5933 (if (or dired-after-readin-hook omit hide)
5934 (save-excursion
5935 (save-restriction
5936 ;; Use start so that we get the new-line at
5937 ;; the beginning of the line in case we want
5938 ;; to hide the file. Don't need to test (bobp)
5939 ;; here, since we never add a file at
5940 ;; the beginning of the buffer.
5941 (narrow-to-region start
5942 (save-excursion (forward-line 1) (point)))
5943 (run-hooks 'dired-after-readin-hook)
5944 (if omit
5945 (let ((dired-omit-silent (or dired-omit-silent 0)))
5946 (dired-omit-region (point-min) (point-max)
5947 (dired-omit-regexp))))
5948 (if hide
5949 (subst-char-in-region (point-min) (1- (point-max))
5950 ?\n ?\r))))))
5951 ;; clobber the extra newline at the end of the line
5952 (end-of-line)
5953 (delete-char 1)))
5954
5955 ;; This is a separate function for the sake of nested dired format.
5956 (defun dired-add-entry-do-indentation (marker-char)
5957 ;; two spaces or a marker plus a space:
5958 (insert (if marker-char
5959 (let ((char (if (integerp marker-char)
5960 marker-char
5961 dired-marker-char)))
5962 (dired-update-marker-counters char)
5963 (dired-update-mode-line-modified)
5964 char)
5965 ?\040)
5966 ?\040))
5967
5968 (defun dired-remove-file (file)
5969 (let ((alist dired-buffers)
5970 buff)
5971 (save-excursion
5972 (while alist
5973 (setq buff (cdr (car alist)))
5974 (if (buffer-name buff)
5975 (progn
5976 (set-buffer buff)
5977 (dired-remove-entry file))
5978 (setq dired-buffers (delq (car alist) dired-buffers)))
5979 (setq alist (cdr alist))))
5980 (or dired-buffers (dired-remove-from-file-name-handler-alist))))
5981
5982 (defun dired-remove-entry (file)
5983 (let ((ddir (expand-file-name default-directory))
5984 (dirname (file-name-as-directory file)))
5985 (if (dired-in-this-tree ddir dirname)
5986 (if (or (memq 'kill-dired-buffer dired-no-confirm)
5987 (y-or-n-p (format "Kill dired buffer %s for %s, too? "
5988 (buffer-name) dired-directory)))
5989 (kill-buffer (current-buffer)))
5990 (if (dired-in-this-tree file ddir)
5991 (let ((alist dired-subdir-alist))
5992 (while alist
5993 (if (dired-in-this-tree (car (car alist)) dirname)
5994 (save-excursion
5995 (goto-char (dired-get-subdir-min (car alist)))
5996 (dired-kill-subdir)))
5997 (setq alist (cdr alist)))
5998 (dired-save-excursion
5999 (and (dired-goto-file file)
6000 (let (buffer-read-only)
6001 (delete-region
6002 (progn (skip-chars-backward "^\n\r")
6003 (or (memq (following-char) '(\n \r ?\ ))
6004 (progn
6005 (dired-update-marker-counters
6006 (following-char) t)
6007 (dired-update-mode-line-modified)))
6008 (1- (point)))
6009 (progn (skip-chars-forward "^\n\r") (point)))
6010 (if dired-verify-modtimes
6011 (dired-set-file-modtime
6012 (file-name-directory (directory-file-name file))
6013 dired-subdir-alist))))))))))
6014
6015 (defun dired-add-file (filename &optional marker-char)
6016 (dired-fun-in-all-buffers
6017 (file-name-directory filename)
6018 (function dired-add-entry) filename marker-char))
6019
6020 (defun dired-relist-file (file)
6021 (dired-uncache file nil)
6022 (dired-fun-in-all-buffers (file-name-directory file)
6023 (function dired-relist-entry) file))
6024
6025 (defun dired-relist-entry (file)
6026 ;; Relist the line for FILE, or just add it if it did not exist.
6027 ;; FILE must be an absolute pathname.
6028 (let* ((file (directory-file-name file))
6029 (directory (file-name-directory file))
6030 (dd (expand-file-name default-directory)))
6031 (if (assoc directory dired-subdir-alist)
6032 (if (or
6033 ;; Not a wildcard
6034 (equal dd dired-directory)
6035 ;; Not top-level
6036 (not (string-equal directory dd))
6037 (and (string-equal directory
6038 (if (consp dired-directory)
6039 (file-name-as-directory
6040 (car dired-directory))
6041 (file-name-directory dired-directory)))
6042 (dired-file-in-wildcard-p dired-directory file)))
6043 (let ((marker (save-excursion
6044 (and (dired-goto-file file)
6045 (dired-file-marker file)))))
6046 ;; recompute omission
6047 (if (eq marker dired-omit-marker-char)
6048 (setq marker nil))
6049 (dired-add-entry file marker 'relist))
6050 ;; At least tell dired that we considered updating the buffer.
6051 (if dired-verify-modtimes
6052 (dired-set-file-modtime directory dired-subdir-alist))))))
6053
6054 (defun dired-file-in-wildcard-p (wildcard file)
6055 ;; Return t if a file is part of the listing for wildcard.
6056 ;; File should be the non-directory part only.
6057 ;; This version is slow, but meticulously correct. Is it worth it?
6058 (if (consp wildcard)
6059 (let ((files (cdr wildcard))
6060 (dir (car wildcard))
6061 yep)
6062 (while (and files (not yep))
6063 (setq yep (string-equal file (expand-file-name (car files) dir))
6064 files (cdr files)))
6065 yep)
6066 (let ((err-buff
6067 (let ((default-major-mode 'fundamental-mode))
6068 (get-buffer-create " *dired-check-process output*")))
6069 (dir default-directory)
6070 (process-connection-type nil))
6071 (save-excursion
6072 (set-buffer err-buff)
6073 (erase-buffer)
6074 (setq default-directory dir)
6075 (call-process shell-file-name nil t nil "-c"
6076 (concat dired-ls-program " -d " wildcard " | "
6077 "egrep '(^|/)" file "$'"))
6078 (/= (buffer-size) 0)))))
6079
6080 ;; The difference between dired-add-file and dired-relist-file is that
6081 ;; the former creates the entry with a specific marker. The later preserves
6082 ;; existing markers on a per buffer basis. This is not the same as
6083 ;; giving dired-create-files a marker of t, which uses a marker in a specific
6084 ;; buffer to determine the marker for file line creation in all buffers.
6085
6086
6087 ;;;; ----------------------------------------------------------------
6088 ;;;; Applying Lisp functions to marked files.
6089 ;;;; ----------------------------------------------------------------
6090
6091 ;;; Running tags commands on marked files.
6092 ;;
6093 ;; Written 8/30/93 by Roland McGrath <roland@gnu.ai.mit.edu>.
6094 ;; Requires tags.el as distributed with GNU Emacs 19.23, or later.
6095
6096 (defun dired-do-tags-search (regexp)
6097 "Search through all marked files for a match for REGEXP.
6098 Stops when a match is found.
6099 To continue searching for next match, use command \\[tags-loop-continue]."
6100 (interactive "sSearch marked files (regexp): ")
6101 (tags-search regexp '(dired-get-marked-files)))
6102
6103 (defun dired-do-tags-query-replace (from to &optional delimited)
6104 "Query-replace-regexp FROM with TO through all marked files.
6105 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
6106 If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
6107 with the command \\[tags-loop-continue]."
6108 (interactive
6109 "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
6110 (tags-query-replace from to delimited '(dired-get-marked-files)))
6111
6112 ;;; byte compiling
6113
6114 (defun dired-byte-compile ()
6115 ;; Return nil for success, offending file name else.
6116 (let* ((filename (dired-get-filename))
6117 buffer-read-only failure)
6118 (condition-case err
6119 (save-excursion (byte-compile-file filename))
6120 (error
6121 (setq failure err)))
6122 ;; We should not need to update any file lines, as this will have
6123 ;; already been done by after-write-region-hook.
6124 (and failure
6125 (progn
6126 (dired-log (buffer-name (current-buffer))
6127 "Byte compile error for %s:\n%s\n" filename failure)
6128 (dired-make-relative filename)))))
6129
6130 (defun dired-do-byte-compile (&optional arg)
6131 "Byte compile marked (or next ARG) Emacs lisp files."
6132 (interactive "P")
6133 (dired-map-over-marks-check (function dired-byte-compile) arg
6134 'byte-compile "byte-compile" t))
6135
6136 ;;; loading
6137
6138 (defun dired-load ()
6139 ;; Return nil for success, offending file name else.
6140 (let ((file (dired-get-filename)) failure)
6141 (condition-case err
6142 (load file nil nil t)
6143 (error (setq failure err)))
6144 (if (not failure)
6145 nil
6146 (dired-log (buffer-name (current-buffer))
6147 "Load error for %s:\n%s\n" file failure)
6148 (dired-make-relative file))))
6149
6150 (defun dired-do-load (&optional arg)
6151 "Load the marked (or next ARG) Emacs lisp files."
6152 (interactive "P")
6153 (dired-map-over-marks-check (function dired-load) arg 'load "load" t))
6154
6155
6156 ;;;; ----------------------------------------------------------------
6157 ;;;; File Name Handler Alist
6158 ;;;; ----------------------------------------------------------------
6159 ;;;
6160 ;;; Make sure that I/O functions maintain dired buffers.
6161
6162 (defun dired-remove-from-file-name-handler-alist ()
6163 ;; Remove dired from the file-name-handler-alist
6164 (setq file-name-handler-alist
6165 (delq nil
6166 (mapcar
6167 (function
6168 (lambda (x)
6169 (and (not (eq (cdr x) 'dired-handler-fn))
6170 x)))
6171 file-name-handler-alist))))
6172
6173 (defun dired-check-file-name-handler-alist ()
6174 ;; Verify that dired is installed as the first item in the alist
6175 (or (eq (cdr (car file-name-handler-alist)) 'dired-handler-fn)
6176 (setq file-name-handler-alist
6177 (cons
6178 '("." . dired-handler-fn)
6179 (dired-remove-from-file-name-handler-alist)))))
6180
6181 (defun dired-handler-fn (op &rest args)
6182 ;; Function to update dired buffers after I/O.
6183 (prog1
6184 (let ((inhibit-file-name-handlers
6185 (cons 'dired-handler-fn
6186 (and (eq inhibit-file-name-operation op)
6187 inhibit-file-name-handlers)))
6188 (inhibit-file-name-operation op))
6189 (apply op args))
6190 (let ((dired-omit-silent t)
6191 (hf (get op 'dired)))
6192 (and hf (funcall hf args)))))
6193
6194 (defun dired-handler-fn-1 (args)
6195 (let ((to (expand-file-name (nth 1 args))))
6196 (or (member to dired-unhandle-add-files)
6197 (dired-relist-file to))))
6198
6199 (defun dired-handler-fn-2 (args)
6200 (let ((from (expand-file-name (car args)))
6201 (to (expand-file-name (nth 1 args))))
6202 ;; Don't remove the original entry if making backups.
6203 ;; Otherwise we lose marks. I'm not completely happy with the
6204 ;; logic here.
6205 (or (and
6206 (eq (nth 2 args) t) ; backups always have OK-IF-OVERWRITE t
6207 (string-equal (car (find-backup-file-name from)) to))
6208 (dired-remove-file from))
6209 (or (member to dired-unhandle-add-files)
6210 (dired-relist-file to))))
6211
6212 (defun dired-handler-fn-3 (args)
6213 (let ((to (expand-file-name (nth 2 args))))
6214 (or (member to dired-unhandle-add-files)
6215 (dired-relist-file to))))
6216
6217 (defun dired-handler-fn-4 (args)
6218 (dired-remove-file (expand-file-name (car args))))
6219
6220 (defun dired-handler-fn-5 (args)
6221 (let ((to (expand-file-name (car args))))
6222 (or (member to dired-unhandle-add-files)
6223 (dired-relist-file to))))
6224
6225 (defun dired-handler-fn-6 (args)
6226 (let ((to (expand-file-name (nth 1 args)))
6227 (old (expand-file-name (car args))))
6228 (or (member to dired-unhandle-add-files)
6229 (dired-relist-file to))
6230 (dired-relist-file old)))
6231
6232 (put 'copy-file 'dired 'dired-handler-fn-1)
6233 (put 'dired-make-relative-symlink 'dired 'dired-handler-fn-1)
6234 (put 'make-symbolic-link 'dired 'dired-handler-fn-1)
6235 (put 'add-name-to-file 'dired 'dired-handler-fn-6)
6236 (put 'rename-file 'dired 'dired-handler-fn-2)
6237 (put 'write-region 'dired 'dired-handler-fn-3)
6238 (put 'delete-file 'dired 'dired-handler-fn-4)
6239 (put 'delete-directory 'dired 'dired-handler-fn-4)
6240 (put 'dired-recursive-delete-directory 'dired 'dired-handler-fn-4)
6241 (put 'make-directory-internal 'dired 'dired-handler-fn-5)
6242 (put 'set-file-modes 'dired 'dired-handler-fn-5)
6243
6244 ;;;; ------------------------------------------------------------
6245 ;;;; Autoload land.
6246 ;;;; ------------------------------------------------------------
6247
6248 ;;; Reading mail (dired-xy)
6249
6250 (autoload 'dired-read-mail "dired-xy"
6251 "Reads the current file as a mail folder." t)
6252 (autoload 'dired-vm "dired-xy" "Run VM on this file." t)
6253 (autoload 'dired-rmail "dired-xy" "Run RMAIL on this file." t)
6254
6255 ;;; Virtual dired (dired-vir)
6256
6257 (autoload 'dired-virtual "dired-vir"
6258 "Put this buffer into virtual dired mode." t)
6259
6260 ;;; Grep (dired-grep)
6261
6262 (autoload 'dired-do-grep "dired-grep" "Grep marked files for a pattern." t)
6263
6264 ;;; Doing diffs (dired-diff)
6265
6266 (autoload 'dired-diff "dired-diff"
6267 "Compare file at point with FILE using `diff'." t)
6268 (autoload 'dired-backup-diff "dired-diff"
6269 "Diff this file with its backup file or vice versa." t)
6270 (autoload 'dired-emerge "dired-diff"
6271 "Merge file at point with FILE using `emerge'." t)
6272 (autoload 'dired-emerge-with-ancestor "dired-diff"
6273 "Merge file at point with FILE, using a common ANCESTOR file." t)
6274 (autoload 'dired-ediff "dired-diff" "Ediff file at point with FILE." t)
6275 (autoload 'dired-epatch "dired-diff" "Patch file at point using `epatch'." t)
6276
6277 ;;; Shell commands (dired-shell)
6278
6279 (autoload 'dired-do-print "dired-shell" "Print the marked (next ARG) files." t)
6280 (autoload 'dired-run-shell-command "dired-shell" nil)
6281 (autoload 'dired-do-shell-command "dired-shell"
6282 "Run a shell command on the marked (or next ARG) files." t)
6283 (autoload 'dired-do-background-shell-command "dired-shell"
6284 "Run a background shell command on marked (or next ARG) files." t)
6285
6286 ;;; Commands using regular expressions (dired-rgxp)
6287
6288 (autoload 'dired-mark-files-regexp "dired-rgxp"
6289 "Mark all files whose names match REGEXP." t)
6290 (autoload 'dired-flag-files-regexp "dired-rgxp"
6291 "Flag for deletion all files whose names match REGEXP." t)
6292 (autoload 'dired-mark-extension "dired-rgxp"
6293 "Mark all files whose names have a given extension." t)
6294 (autoload 'dired-flag-extension "dired-rgxp"
6295 "Flag for deletion all files whose names have a given extension." t)
6296 (autoload 'dired-cleanup "dired-rgxp"
6297 "Flag for deletion dispensable files files created by PROGRAM." t)
6298 (autoload 'dired-do-rename-regexp "dired-rgxp"
6299 "Rename marked files whose names match a given regexp." t)
6300 (autoload 'dired-do-copy-regexp "dired-rgxp"
6301 "Copy marked files whose names match a given regexp." t)
6302 (autoload 'dired-do-hardlink-regexp "dired-rgxp"
6303 "Hardlink all marked files whose names match a regexp." t)
6304 (autoload 'dired-do-symlink "dired-rgxp"
6305 "Make a symbolic link to all files whose names match a regexp." t)
6306 (autoload
6307 'dired-do-relsymlink-regexp "dired-rgxp"
6308 "Make a relative symbolic link to all files whose names match a regexp." t)
6309 (autoload 'dired-upcase "dired-rgxp"
6310 "Rename all marked (or next ARG) files to upper case." t)
6311 (autoload 'dired-downcase "dired-rgxp"
6312 "Rename all marked (or next ARG) files to lower case." t)
6313
6314 ;;; Marking files from other buffers (dired-mob)
6315
6316 (autoload 'dired-mark-files-from-other-dired-buffer "dired-mob"
6317 "Mark files which are marked in another dired buffer." t)
6318 (autoload 'dired-mark-files-compilation-buffer "dired-mob"
6319 "Mark the files mentioned in the compilation buffer." t)
6320
6321 ;;; uuencoding (dired-uu)
6322
6323 (autoload 'dired-do-uucode "dired-uu" "Uuencode or uudecode marked files." t)
6324
6325 ;;; Compressing (dired-cmpr)
6326
6327 (autoload 'dired-do-compress "dired-cmpr"
6328 "Compress or uncompress marked files." t)
6329 (autoload 'dired-compress-subdir-files "dired-cmpr"
6330 "Compress uncompressed files in the current subdirectory." t)
6331
6332
6333 ;;; Marking files according to sexps
6334
6335 (autoload 'dired-mark-sexp "dired-sex"
6336 "Mark files according to an sexpression." t)
6337
6338 ;;; Help!
6339
6340 (autoload 'dired-summary "dired-help"
6341 "Display summary of basic dired commands in the minibuffer." t)
6342 (autoload 'dired-describe-mode "dired-help"
6343 "Detailed description of dired mode.
6344 With a prefix, runs the info documentation browser for dired." t)
6345 (autoload 'dired-apropos "dired-help"
6346 "Do command apropos help for dired commands.
6347 With prefix does apropos help for dired variables." t)
6348 (autoload 'dired-report-bug "dired-help" "Report a bug for dired." t)
6349
6350 ;;;; --------------------------------------------------------------
6351 ;;;; Multi-flavour Emacs support
6352 ;;;; --------------------------------------------------------------
6353
6354 (let ((lucid-p (string-match "Lucid" emacs-version))
6355 ver)
6356 (or (string-match "^\\([0-9]+\\)\\." emacs-version)
6357 (error "Weird emacs version %s" emacs-version))
6358 (setq ver (string-to-int (substring emacs-version (match-beginning 1)
6359 (match-end 1))))
6360
6361 ;; Reading with history.
6362 (if (>= ver 19)
6363
6364 (defun dired-read-with-history (prompt initial history)
6365 (read-from-minibuffer prompt initial nil nil history))
6366
6367 (defun dired-read-with-history (prompt initial history)
6368 (let ((minibuffer-history-symbol history)) ; for gmhist
6369 (read-string prompt initial))))
6370
6371 ;; Completing read with history.
6372 (if (>= ver 19)
6373
6374 (fset 'dired-completing-read 'completing-read)
6375
6376 (defun dired-completing-read (prompt table &optional predicate
6377 require-match initial-input history)
6378 (let ((minibuffer-history-symbol history)) ; for gmhist
6379 (completing-read prompt table predicate require-match
6380 initial-input))))
6381
6382 ;; Abbreviating file names.
6383 (if lucid-p
6384 (fset 'dired-abbreviate-file-name
6385 ;; Lemacs has this extra hack-homedir arg
6386 (function
6387 (lambda (fn)
6388 (abbreviate-file-name fn t))))
6389 (fset 'dired-abbreviate-file-name 'abbreviate-file-name))
6390
6391 ;; Deleting directories
6392 ;; Check for pre 19.8 versions of lucid emacs.
6393 (if lucid-p
6394 (or (fboundp 'delete-directory)
6395 (fset 'delete-directory 'remove-directory)))
6396
6397 ;; Minibuffers
6398 (if (= ver 18)
6399
6400 (defun dired-get-active-minibuffer-window ()
6401 (and (> (minibuffer-depth) 0)
6402 (minibuffer-window)))
6403
6404 (defun dired-get-active-minibuffer-window ()
6405 (let ((frames (frame-list))
6406 win found)
6407 (while frames
6408 (if (and (setq win (minibuffer-window (car frames)))
6409 (minibuffer-window-active-p win))
6410 (setq found win
6411 frames nil)
6412 (setq frames (cdr frames))))
6413 found)))
6414
6415 ;; Text properties and menus.
6416
6417 (cond
6418 (lucid-p
6419 (require 'dired-xemacs))
6420 ((>= ver 19)
6421 (require 'dired-fsf))
6422 (t
6423 ;; text property stuff doesn't work in V18
6424 (fset 'dired-insert-set-properties 'ignore)
6425 (fset 'dired-remove-text-properties 'ignore)
6426 (fset 'dired-set-text-properties 'ignore)
6427 (fset 'dired-move-to-filename 'dired-manual-move-to-filename)
6428 (fset 'dired-move-to-end-of-filename
6429 'dired-manual-move-to-end-of-filename))))
6430
6431 ;;; MULE
6432
6433 (if (or (boundp 'MULE) (featurep 'mule)) (load "dired-mule"))
6434
6435
6436 ;; Run load hook for user customization.
6437 (run-hooks 'dired-load-hook)
6438
6439 ;;; end of dired.el