* progmodes/octave.el (inferior-octave-directory-tracker-resync):
[bpt/emacs.git] / lisp / dired-aux.el
CommitLineData
276f1d00 1;;; dired-aux.el --- less commonly used parts of dired
dd87891b 2
ab422c4d
PE
3;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2013 Free Software
4;; Foundation, Inc.
3a801d0c 5
2f14b48d 6;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
0acdb863 7;; Maintainer: FSF
565132a3 8;; Keywords: files
bd78fa1d 9;; Package: emacs
e5167999 10
dd87891b
RS
11;; This file is part of GNU Emacs.
12
eb3fa2cf 13;; GNU Emacs is free software: you can redistribute it and/or modify
dd87891b 14;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
dd87891b
RS
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
dd87891b 25
2f14b48d
ER
26;;; Commentary:
27
e41b2db1
ER
28;; The parts of dired mode not normally used. This is a space-saving hack
29;; to avoid having to load a large mode when all that's wanted are a few
30;; functions.
31
dd87891b
RS
32;; Rewritten in 1990/1991 to add tree features, file marking and
33;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
34;; Finished up by rms in 1992.
35
2f14b48d
ER
36;;; Code:
37
55d77548
RS
38;; We need macros in dired.el to compile properly,
39;; and we call subroutines in it too.
40(require 'dired)
6482fcac 41
c62a8073
RS
42(defvar dired-create-files-failures nil
43 "Variable where `dired-create-files' records failing file names.
44Functions that operate recursively can store additional names
45into this list; they also should call `dired-log' to log the errors.")
46
dd87891b
RS
47;;; 15K
48;;;###begin dired-cmd.el
49;; Diffing and compressing
50
edb8d73e
FP
51(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
52(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
53
dd87891b
RS
54;;;###autoload
55(defun dired-diff (file &optional switches)
56 "Compare file at point with file FILE using `diff'.
2fd5e67d 57If called interactively, prompt for FILE. If the file at point
9d232fc4
JL
58has a backup file, use that as the default. If the file at point
59is a backup file, use its original. If the mark is active
2fd5e67d
JL
60in Transient Mark mode, use the file at the mark as the default.
61\(That's the mark set by \\[set-mark-command], not by Dired's
62\\[dired-mark] command.)
63
64FILE is the first file given to `diff'. The file at point
65is the second file given to `diff'.
35d98877 66
2fd5e67d
JL
67With prefix arg, prompt for second argument SWITCHES, which is
68the string of command switches for the third argument of `diff'."
dd87891b 69 (interactive
e237085f 70 (let* ((current (dired-get-filename t))
9d232fc4
JL
71 ;; Get the latest existing backup file or its original.
72 (oldf (if (backup-file-name-p current)
73 (file-name-sans-versions current)
74 (diff-latest-backup-file current)))
2fd5e67d
JL
75 ;; Get the file at the mark.
76 (file-at-mark (if (and transient-mark-mode mark-active)
77 (save-excursion (goto-char (mark t))
78 (dired-get-filename t t))))
79 (default-file (or file-at-mark
80 (and oldf (file-name-nondirectory oldf))))
81 ;; Use it as default if it's not the same as the current file,
82 ;; and the target dir is current or there is a default file.
83 (default (if (and (not (equal default-file current))
84 (or (equal (dired-dwim-target-directory)
85 (dired-current-directory))
86 default-file))
87 default-file))
88 (target-dir (if default
89 (dired-current-directory)
90 (dired-dwim-target-directory)))
91 (defaults (dired-dwim-target-defaults (list current) target-dir)))
92 (list
93 (minibuffer-with-setup-hook
94 (lambda ()
95 (set (make-local-variable 'minibuffer-default-add-function) nil)
96 (setq minibuffer-default defaults))
97 (read-file-name
98 (format "Diff %s with%s: " current
99 (if default (format " (default %s)" default) ""))
100 target-dir default t))
101 (if current-prefix-arg
102 (read-string "Options for diff: "
103 (if (stringp diff-switches)
104 diff-switches
105 (mapconcat 'identity diff-switches " ")))))))
ad974e9e
JL
106 (let ((current (dired-get-filename t)))
107 (when (or (equal (expand-file-name file)
108 (expand-file-name current))
109 (and (file-directory-p file)
110 (equal (expand-file-name current file)
111 (expand-file-name current))))
112 (error "Attempt to compare the file to itself"))
9d232fc4
JL
113 (if (and (backup-file-name-p current)
114 (equal file (file-name-sans-versions current)))
115 (diff current file switches)
116 (diff file current switches))))
dd87891b
RS
117
118;;;###autoload
119(defun dired-backup-diff (&optional switches)
120 "Diff this file with its backup file or vice versa.
121Uses the latest backup, if there are several numerical backups.
122If this file is a backup, diff it with its original.
fe5e3a2a
RS
123The backup file is the first file given to `diff'.
124With prefix arg, prompt for argument SWITCHES which is options for `diff'."
125 (interactive
126 (if current-prefix-arg
127 (list (read-string "Options for diff: "
128 (if (stringp diff-switches)
129 diff-switches
130 (mapconcat 'identity diff-switches " "))))
131 nil))
132 (diff-backup (dired-get-filename) switches))
dd87891b 133
3659a2b8 134;;;###autoload
d1c553c8
RS
135(defun dired-compare-directories (dir2 predicate)
136 "Mark files with different file attributes in two dired buffers.
137Compare file attributes of files in the current directory
138with file attributes in directory DIR2 using PREDICATE on pairs of files
139with the same name. Mark files for which PREDICATE returns non-nil.
999bd52a 140Mark files with different names if PREDICATE is nil (or interactively
3659a2b8 141with empty input at the predicate prompt).
d1c553c8
RS
142
143PREDICATE is a Lisp expression that can refer to the following variables:
144
145 size1, size2 - file size in bytes
146 mtime1, mtime2 - last modification time in seconds, as a float
147 fa1, fa2 - list of file attributes
148 returned by function `file-attributes'
149
150 where 1 refers to attribute of file in the current dired buffer
151 and 2 to attribute of file in second dired buffer.
152
153Examples of PREDICATE:
154
155 (> mtime1 mtime2) - mark newer files
156 (not (= size1 size2)) - mark files with different sizes
157 (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes
158 (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID
159 (= (nth 3 fa1) (nth 3 fa2)))) and GID."
160 (interactive
e237085f
JL
161 (list
162 (let* ((target-dir (dired-dwim-target-directory))
163 (defaults (dired-dwim-target-defaults nil target-dir)))
164 (minibuffer-with-setup-hook
165 (lambda ()
166 (set (make-local-variable 'minibuffer-default-add-function) nil)
167 (setq minibuffer-default defaults))
168 (read-directory-name (format "Compare %s with: "
169 (dired-current-directory))
170 target-dir target-dir t)))
171 (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")))
d1c553c8
RS
172 (let* ((dir1 (dired-current-directory))
173 (file-alist1 (dired-files-attributes dir1))
174 (file-alist2 (dired-files-attributes dir2))
5176af43
RS
175 file-list1 file-list2)
176 (setq file-alist1 (delq (assoc "." file-alist1) file-alist1))
177 (setq file-alist1 (delq (assoc ".." file-alist1) file-alist1))
178 (setq file-alist2 (delq (assoc "." file-alist2) file-alist2))
179 (setq file-alist2 (delq (assoc ".." file-alist2) file-alist2))
180 (setq file-list1 (mapcar
d1c553c8
RS
181 'cadr
182 (dired-file-set-difference
183 file-alist1 file-alist2
5176af43
RS
184 predicate))
185 file-list2 (mapcar
d1c553c8
RS
186 'cadr
187 (dired-file-set-difference
188 file-alist2 file-alist1
5176af43 189 predicate)))
d1c553c8
RS
190 (dired-fun-in-all-buffers
191 dir1 nil
192 (lambda ()
193 (dired-mark-if
194 (member (dired-get-filename nil t) file-list1) nil)))
195 (dired-fun-in-all-buffers
196 dir2 nil
197 (lambda ()
198 (dired-mark-if
199 (member (dired-get-filename nil t) file-list2) nil)))
200 (message "Marked in dir1: %s files, in dir2: %s files"
201 (length file-list1)
202 (length file-list2))))
203
204(defun dired-file-set-difference (list1 list2 predicate)
205 "Combine LIST1 and LIST2 using a set-difference operation.
206The result list contains all file items that appear in LIST1 but not LIST2.
207This is a non-destructive function; it makes a copy of the data if necessary
208to avoid corrupting the original LIST1 and LIST2.
209PREDICATE (see `dired-compare-directories') is an additional match
210condition. Two file items are considered to match if they are equal
211*and* PREDICATE evaluates to t."
212 (if (or (null list1) (null list2))
213 list1
214 (let (res)
215 (dolist (file1 list1)
216 (unless (let ((list list2))
217 (while (and list
218 (not (let* ((file2 (car list))
9375be01
JPW
219 (fa1 (car (cddr file1)))
220 (fa2 (car (cddr file2)))
d1c553c8
RS
221 (size1 (nth 7 fa1))
222 (size2 (nth 7 fa2))
223 (mtime1 (float-time (nth 5 fa1)))
224 (mtime2 (float-time (nth 5 fa2))))
225 (and
226 (equal (car file1) (car file2))
227 (not (eval predicate))))))
228 (setq list (cdr list)))
229 list)
230 (setq res (cons file1 res))))
231 (nreverse res))))
232
233(defun dired-files-attributes (dir)
234 "Return a list of all file names and attributes from DIR.
5a0c3f56 235List has a form of (file-name full-file-name (attribute-list))."
d1c553c8
RS
236 (mapcar
237 (lambda (file-name)
238 (let ((full-file-name (expand-file-name file-name dir)))
239 (list file-name
240 full-file-name
241 (file-attributes full-file-name))))
242 (directory-files dir)))
243\f
2cc8e51a 244;;; Change file attributes
52f134ee 245
dd87891b 246(defun dired-do-chxxx (attribute-name program op-symbol arg)
2cc8e51a 247 ;; Change file attributes (group, owner, timestamp) of marked files and
dd87891b
RS
248 ;; refresh their file lines.
249 ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
250 ;; PROGRAM is the program used to change the attribute.
2cc8e51a
JL
251 ;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
252 ;; ARG describes which files to use, as in `dired-get-marked-files'.
dd87891b 253 (let* ((files (dired-get-marked-files t arg))
20f70ede 254 ;; The source of default file attributes is the file at point.
12734222 255 (default-file (dired-get-filename t t))
20f70ede
JL
256 (default (when default-file
257 (cond ((eq op-symbol 'touch)
258 (format-time-string
259 "%Y%m%d%H%M.%S"
260 (nth 5 (file-attributes default-file))))
261 ((eq op-symbol 'chown)
262 (nth 2 (file-attributes default-file 'string)))
263 ((eq op-symbol 'chgrp)
264 (nth 3 (file-attributes default-file 'string))))))
64b51947
CY
265 (prompt (concat "Change " attribute-name " of %s to"
266 (if (eq op-symbol 'touch)
267 " (default now): "
268 ": ")))
269 (new-attribute (dired-mark-read-string prompt nil op-symbol
30009afd
DA
270 arg files default
271 (cond ((eq op-symbol 'chown)
272 (system-users))
273 ((eq op-symbol 'chgrp)
274 (system-groups)))))
dd87891b
RS
275 (operation (concat program " " new-attribute))
276 failures)
277 (setq failures
278 (dired-bunch-files 10000
279 (function dired-check-process)
edb8d73e 280 (append
3ccd3160 281 (list operation program)
5b68b333
JL
282 (unless (or (string-equal new-attribute "")
283 ;; Use `eq' instead of `equal'
284 ;; to detect empty input (bug#12399).
285 (eq new-attribute default))
64b51947
CY
286 (if (eq op-symbol 'touch)
287 (list "-t" new-attribute)
288 (list new-attribute)))
05a455e2
RS
289 (if (string-match "gnu" system-configuration)
290 '("--") nil))
dd87891b
RS
291 files))
292 (dired-do-redisplay arg);; moves point if ARG is an integer
293 (if failures
294 (dired-log-summary
295 (format "%s: error" operation)
296 nil))))
297
298;;;###autoload
299(defun dired-do-chmod (&optional arg)
300 "Change the mode of the marked (or next ARG) files.
20f70ede
JL
301Symbolic modes like `g+w' are allowed.
302Type M-n to pull the file attributes of the file at point
303into the minibuffer."
dd87891b 304 (interactive "P")
822b17d3 305 (let* ((files (dired-get-marked-files t arg))
20f70ede 306 ;; The source of default file attributes is the file at point.
12734222 307 (default-file (dired-get-filename t t))
20f70ede
JL
308 (modestr (when default-file
309 (nth 8 (file-attributes default-file))))
78be566d
JL
310 (default
311 (and (stringp modestr)
312 (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
313 (replace-regexp-in-string
314 "-" ""
315 (format "u=%s,g=%s,o=%s"
316 (match-string 1 modestr)
317 (match-string 2 modestr)
318 (match-string 3 modestr)))))
822b17d3 319 (modes (dired-mark-read-string
64b51947 320 "Change mode of %s to: "
a0bf2bcd 321 nil 'chmod arg files default))
64b51947 322 num-modes)
cb26b7f5
JL
323 (cond ((or (equal modes "")
324 ;; Use `eq' instead of `equal'
325 ;; to detect empty input (bug#12399).
326 (eq modes default))
64b51947
CY
327 ;; We used to treat empty input as DEFAULT, but that is not
328 ;; such a good idea (Bug#9361).
329 (error "No file mode specified"))
330 ((string-match "^[0-7]+" modes)
331 (setq num-modes (string-to-number modes 8))))
332
822b17d3
MC
333 (dolist (file files)
334 (set-file-modes
335 file
336 (if num-modes num-modes
337 (file-modes-symbolic-to-number modes (file-modes file)))))
338 (dired-do-redisplay arg)))
dd87891b
RS
339
340;;;###autoload
341(defun dired-do-chgrp (&optional arg)
20f70ede
JL
342 "Change the group of the marked (or next ARG) files.
343Type M-n to pull the file attributes of the file at point
344into the minibuffer."
dd87891b 345 (interactive "P")
a40dbafc 346 (if (memq system-type '(ms-dos windows-nt))
55535639 347 (error "chgrp not supported on this system"))
dd87891b
RS
348 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
349
350;;;###autoload
351(defun dired-do-chown (&optional arg)
20f70ede
JL
352 "Change the owner of the marked (or next ARG) files.
353Type M-n to pull the file attributes of the file at point
354into the minibuffer."
dd87891b 355 (interactive "P")
a40dbafc 356 (if (memq system-type '(ms-dos windows-nt))
55535639 357 (error "chown not supported on this system"))
dd87891b
RS
358 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
359
05dcf18a 360;;;###autoload
3ccd3160
JL
361(defun dired-do-touch (&optional arg)
362 "Change the timestamp of the marked (or next ARG) files.
20f70ede
JL
363This calls touch.
364Type M-n to pull the file attributes of the file at point
365into the minibuffer."
3ccd3160
JL
366 (interactive "P")
367 (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
368
dd87891b
RS
369;; Process all the files in FILES in batches of a convenient size,
370;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
371;; Batches are chosen to need less than MAX chars for the file names,
372;; allowing 3 extra characters of separator per file name.
373(defun dired-bunch-files (max function args files)
374 (let (pending
e5369aad 375 past
dd87891b
RS
376 (pending-length 0)
377 failures)
378 ;; Accumulate files as long as they fit in MAX chars,
379 ;; then process the ones accumulated so far.
380 (while files
381 (let* ((thisfile (car files))
382 (thislength (+ (length thisfile) 3))
383 (rest (cdr files)))
384 ;; If we have at least 1 pending file
385 ;; and this file won't fit in the length limit, process now.
386 (if (and pending (> (+ thislength pending-length) max))
e5369aad
RS
387 (setq pending (nreverse pending)
388 ;; The elements of PENDING are now in forward order.
389 ;; Do the operation and record failures.
390 failures (nconc (apply function (append args pending))
391 failures)
4c36be58 392 ;; Transfer the elements of PENDING onto PAST
e5369aad
RS
393 ;; and clear it out. Now PAST contains the first N files
394 ;; specified (for some N), and FILES contains the rest.
395 past (nconc past pending)
dd87891b
RS
396 pending nil
397 pending-length 0))
398 ;; Do (setq pending (cons thisfile pending))
399 ;; but reuse the cons that was in `files'.
400 (setcdr files pending)
401 (setq pending files)
402 (setq pending-length (+ thislength pending-length))
403 (setq files rest)))
e5369aad
RS
404 (setq pending (nreverse pending))
405 (prog1
406 (nconc (apply function (append args pending))
407 failures)
408 ;; Now the original list FILES has been put back as it was.
409 (nconc past pending))))
dd87891b
RS
410
411;;;###autoload
412(defun dired-do-print (&optional arg)
413 "Print the marked (or next ARG) files.
414Uses the shell command coming from variables `lpr-command' and
415`lpr-switches' as default."
416 (interactive "P")
417 (let* ((file-list (dired-get-marked-files t arg))
418 (command (dired-mark-read-string
419 "Print %s with: "
c572e732
RS
420 (mapconcat 'identity
421 (cons lpr-command
422 (if (stringp lpr-switches)
423 (list lpr-switches)
424 lpr-switches))
425 " ")
dd87891b
RS
426 'print arg file-list)))
427 (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
428
64b51947 429(defun dired-mark-read-string (prompt initial op-symbol arg files
30009afd 430 &optional default-value collection)
64b51947
CY
431 "Read args for a Dired marked-files command, prompting with PROMPT.
432Return the user input (a string).
433
434INITIAL, if non-nil, is the initial minibuffer input.
435OP-SYMBOL is an operation symbol (see `dired-no-confirm').
c5695d1d
CY
436ARG is normally the prefix argument for the calling command;
437it is passed as the first argument to `dired-mark-prompt'.
438FILES should be a list of marked files' names.
64b51947 439
c5695d1d
CY
440Optional arg DEFAULT-VALUE is a default value or list of default
441values, passed as the seventh arg to `completing-read'.
12e10e61 442
c5695d1d
CY
443Optional arg COLLECTION is a collection of possible completions,
444passed as the second arg to `completing-read'."
64b51947 445 (dired-mark-pop-up nil op-symbol files
30009afd 446 'completing-read
64b51947 447 (format prompt (dired-mark-prompt arg files))
30009afd 448 collection nil nil initial nil default-value nil))
83fadedf 449\f
2d051399
RS
450;;; Cleaning a directory: flagging some backups for deletion.
451
6482fcac
RS
452(defvar dired-file-version-alist)
453
05dcf18a 454;;;###autoload
2d051399
RS
455(defun dired-clean-directory (keep)
456 "Flag numerical backups for deletion.
457Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
458Positive prefix arg KEEP overrides `dired-kept-versions';
459Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
460
461To clear the flags on these files, you can use \\[dired-flag-backup-files]
462with a prefix argument."
463 (interactive "P")
464 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
465 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
466 (late-retention (if (<= keep 0) dired-kept-versions keep))
467 (dired-file-version-alist ()))
468 (message "Cleaning numerical backups (keeping %d late, %d old)..."
469 late-retention early-retention)
470 ;; Look at each file.
471 ;; If the file has numeric backup versions,
472 ;; put on dired-file-version-alist an element of the form
473 ;; (FILENAME . VERSION-NUMBER-LIST)
474 (dired-map-dired-file-lines (function dired-collect-file-versions))
475 ;; Sort each VERSION-NUMBER-LIST,
476 ;; and remove the versions not to be deleted.
477 (let ((fval dired-file-version-alist))
478 (while fval
479 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
480 (v-count (length sorted-v-list)))
481 (if (> v-count (+ early-retention late-retention))
482 (rplacd (nthcdr early-retention sorted-v-list)
483 (nthcdr (- v-count late-retention)
484 sorted-v-list)))
485 (rplacd (car fval)
486 (cdr sorted-v-list)))
487 (setq fval (cdr fval))))
488 ;; Look at each file. If it is a numeric backup file,
489 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
490 (dired-map-dired-file-lines (function dired-trample-file-versions))
491 (message "Cleaning numerical backups...done")))
492
493;;; Subroutines of dired-clean-directory.
494
495(defun dired-map-dired-file-lines (fun)
496 ;; Perform FUN with point at the end of each non-directory line.
57dabf6b 497 ;; FUN takes one argument, the absolute filename.
2d051399
RS
498 (save-excursion
499 (let (file buffer-read-only)
500 (goto-char (point-min))
501 (while (not (eobp))
502 (save-excursion
503 (and (not (looking-at dired-re-dir))
504 (not (eolp))
505 (setq file (dired-get-filename nil t)) ; nil on non-file
506 (progn (end-of-line)
507 (funcall fun file))))
508 (forward-line 1)))))
509
06b60517
JB
510(defvar backup-extract-version-start) ; used in backup-extract-version
511
2d051399 512(defun dired-collect-file-versions (fn)
61c6f873
RS
513 (let ((fn (file-name-sans-versions fn)))
514 ;; Only do work if this file is not already in the alist.
515 (if (assoc fn dired-file-version-alist)
516 nil
517 ;; If it looks like file FN has versions, return a list of the versions.
518 ;;That is a list of strings which are file names.
f9acc7fb 519 ;;The caller may want to flag some of these files for deletion.
61c6f873
RS
520 (let* ((base-versions
521 (concat (file-name-nondirectory fn) ".~"))
afbd0a53 522 (backup-extract-version-start (length base-versions))
61c6f873
RS
523 (possibilities (file-name-all-completions
524 base-versions
525 (file-name-directory fn)))
526 (versions (mapcar 'backup-extract-version possibilities)))
527 (if versions
528 (setq dired-file-version-alist
529 (cons (cons fn versions)
530 dired-file-version-alist)))))))
2d051399
RS
531
532(defun dired-trample-file-versions (fn)
533 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
534 base-version-list)
535 (and start-vn
536 (setq base-version-list ; there was a base version to which
537 (assoc (substring fn 0 start-vn) ; this looks like a
538 dired-file-version-alist)) ; subversion
027a4b6b 539 (not (memq (string-to-number (substring fn (+ 2 start-vn)))
2d051399
RS
540 base-version-list)) ; this one doesn't make the cut
541 (progn (beginning-of-line)
542 (delete-char 1)
543 (insert dired-del-marker)))))
83fadedf 544\f
dd87891b 545;;; Shell commands
dd87891b 546
905eb9ff
JL
547(declare-function mailcap-file-default-commands "mailcap" (files))
548
549(defun minibuffer-default-add-dired-shell-commands ()
b8f908b3
JL
550 "Return a list of all commands associated with current dired files.
551This function is used to add all related commands retrieved by `mailcap'
905eb9ff
JL
552to the end of the list of defaults just after the default value."
553 (interactive)
554 (let ((commands (and (boundp 'files) (require 'mailcap nil t)
555 (mailcap-file-default-commands files))))
556 (if (listp minibuffer-default)
557 (append minibuffer-default commands)
558 (cons minibuffer-default commands))))
2f8a5963 559
1906dec4 560;; This is an extra function so that you can redefine it, e.g., to use gmhist.
dd87891b 561(defun dired-read-shell-command (prompt arg files)
f69fd0d2
CY
562 "Read a dired shell command.
563PROMPT should be a format string with one \"%s\" format sequence,
564which is replaced by the value returned by `dired-mark-prompt',
565with ARG and FILES as its arguments. FILES should be a list of
566file names. The result is used as the prompt.
567
568This normally reads using `read-shell-command', but if the
569`dired-x' package is loaded, use `dired-guess-shell-command' to
570offer a smarter default choice of shell command."
905eb9ff
JL
571 (minibuffer-with-setup-hook
572 (lambda ()
573 (set (make-local-variable 'minibuffer-default-add-function)
574 'minibuffer-default-add-dired-shell-commands))
d6e96966 575 (setq prompt (format prompt (dired-mark-prompt arg files)))
f69fd0d2 576 (if (functionp 'dired-guess-shell-command)
d6e96966 577 (dired-mark-pop-up nil 'shell files
f69fd0d2 578 'dired-guess-shell-command prompt files)
d6e96966 579 (dired-mark-pop-up nil 'shell files
f69fd0d2 580 'read-shell-command prompt nil nil))))
dd87891b 581
5ec0c892
JL
582;;;###autoload
583(defun dired-do-async-shell-command (command &optional arg file-list)
584 "Run a shell command COMMAND on the marked files asynchronously.
585
6dafa0d5
JL
586Like `dired-do-shell-command', but adds `&' at the end of COMMAND
587to execute it asynchronously.
588
589When operating on multiple files, asynchronous commands
590are executed in the background on each file in parallel.
591In shell syntax this means separating the individual commands
592with `&'. However, when COMMAND ends in `;' or `;&' then commands
593are executed in the background on each file sequentially waiting
594for each command to terminate before running the next command.
595In shell syntax this means separating the individual commands with `;'.
596
5ec0c892
JL
597The output appears in the buffer `*Async Shell Command*'."
598 (interactive
599 (let ((files (dired-get-marked-files t current-prefix-arg)))
600 (list
601 ;; Want to give feedback whether this file or marked files are used:
602 (dired-read-shell-command "& on %s: " current-prefix-arg files)
603 current-prefix-arg
604 files)))
5ec0c892
JL
605 (unless (string-match "&[ \t]*\\'" command)
606 (setq command (concat command " &")))
607 (dired-do-shell-command command arg file-list))
608
dd87891b 609;;;###autoload
01db6210 610(defun dired-do-shell-command (command &optional arg file-list)
6482fcac 611 "Run a shell command COMMAND on the marked files.
6dafa0d5 612If no files are marked or a numeric prefix arg is given,
6482fcac
RS
613the next ARG files are used. Just \\[universal-argument] means the current file.
614The prompt mentions the file(s) or the marker, as appropriate.
615
eab9ed67
RS
616If there is a `*' in COMMAND, surrounded by whitespace, this runs
617COMMAND just once with the entire file list substituted there.
6482fcac 618
eab9ed67
RS
619If there is no `*', but there is a `?' in COMMAND, surrounded by
620whitespace, this runs COMMAND on each file individually with the
621file name substituted for `?'.
dd87891b 622
eab9ed67
RS
623Otherwise, this runs COMMAND on each file individually with the
624file name added at the end of COMMAND (separated by a space).
d984dbc1 625
eab9ed67
RS
626`*' and `?' when not surrounded by whitespace have no special
627significance for `dired-do-shell-command', and are passed through
09044622
GM
628normally to the shell, but you must confirm first.
629
630If you want to use `*' as a shell wildcard with whitespace around
631it, write `*\"\"' in place of just `*'. This is equivalent to just
632`*' in the shell, but avoids Dired's special handling.
dd87891b 633
6dafa0d5
JL
634If COMMAND ends in `&', `;', or `;&', it is executed in the
635background asynchronously, and the output appears in the buffer
636`*Async Shell Command*'. When operating on multiple files and COMMAND
637ends in `&', the shell command is executed on each file in parallel.
638However, when COMMAND ends in `;' or `;&' then commands are executed
639in the background on each file sequentially waiting for each command
640to terminate before running the next command. You can also use
641`dired-do-async-shell-command' that automatically adds `&'.
642
643Otherwise, COMMAND is executed synchronously, and the output
644appears in the buffer `*Shell Command Output*'.
eab9ed67
RS
645
646This feature does not try to redisplay Dired buffers afterward, as
647there's no telling what files COMMAND may have changed.
648Type \\[dired-do-redisplay] to redisplay the marked files.
649
5a0c3f56
JB
650When COMMAND runs, its working directory is the top-level directory
651of the Dired buffer, so output files usually are created there
652instead of in a subdir.
9e545350
KH
653
654In a noninteractive call (from Lisp code), you must specify
40c50be3
EZ
655the list of file names explicitly with the FILE-LIST argument, which
656can be produced by `dired-get-marked-files', for example."
dd87891b
RS
657;;Functions dired-run-shell-command and dired-shell-stuff-it do the
658;;actual work and can be redefined for customization.
01db6210
RS
659 (interactive
660 (let ((files (dired-get-marked-files t current-prefix-arg)))
661 (list
662 ;; Want to give feedback whether this file or marked files are used:
6dafa0d5 663 (dired-read-shell-command "! on %s: " current-prefix-arg files)
01db6210
RS
664 current-prefix-arg
665 files)))
edb8d73e 666 (let* ((on-each (not (string-match dired-star-subst-regexp command)))
e52c37fa
GM
667 (no-subst (not (string-match dired-quark-subst-regexp command)))
668 (star (string-match "\\*" command))
669 (qmark (string-match "\\?" command)))
eab9ed67
RS
670 ;; Get confirmation for wildcards that may have been meant
671 ;; to control substitution of a file name or the file name list.
e52c37fa 672 (if (cond ((not (or on-each no-subst))
edb8d73e 673 (error "You can not combine `*' and `?' substitution marks"))
e52c37fa 674 ((and star on-each)
eab9ed67 675 (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
e52c37fa 676 ((and qmark no-subst)
eab9ed67
RS
677 (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
678 (t))
679 (if on-each
680 (dired-bunch-files
681 (- 10000 (length command))
682 (function (lambda (&rest files)
683 (dired-run-shell-command
684 (dired-shell-stuff-it command files t arg))))
685 nil
686 file-list)
687 ;; execute the shell command
688 (dired-run-shell-command
689 (dired-shell-stuff-it command file-list nil arg))))))
dd87891b
RS
690
691;; Might use {,} for bash or csh:
692(defvar dired-mark-prefix ""
693 "Prepended to marked files in dired shell commands.")
694(defvar dired-mark-postfix ""
695 "Appended to marked files in dired shell commands.")
696(defvar dired-mark-separator " "
697 "Separates marked files in dired shell commands.")
698
06b60517 699(defun dired-shell-stuff-it (command file-list on-each &optional _raw-arg)
dd87891b
RS
700;; "Make up a shell command line from COMMAND and FILE-LIST.
701;; If ON-EACH is t, COMMAND should be applied to each file, else
702;; simply concat all files and apply COMMAND to this.
703;; FILE-LIST's elements will be quoted for the shell."
704;; Might be redefined for smarter things and could then use RAW-ARG
705;; (coming from interactive P and currently ignored) to decide what to do.
706;; Smart would be a way to access basename or extension of file names.
6dafa0d5
JL
707 (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
708 (command (if in-background
709 (substring command 0 (match-beginning 0))
710 command))
711 (sequentially (string-match "[ \t]*;[ \t]*\\'" command))
712 (command (if sequentially
713 (substring command 0 (match-beginning 0))
714 command))
715 (stuff-it
716 (if (or (string-match dired-star-subst-regexp command)
717 (string-match dired-quark-subst-regexp command))
718 (lambda (x)
719 (let ((retval command))
720 (while (string-match
721 "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
722 (setq retval (replace-match x t t retval 2)))
723 retval))
724 (lambda (x) (concat command dired-mark-separator x)))))
725 (concat
726 (if on-each
727 (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
728 (if (and in-background (not sequentially)) "&" ";"))
729 (let ((files (mapconcat 'shell-quote-argument
730 file-list dired-mark-separator)))
731 (if (> (length file-list) 1)
732 (setq files (concat dired-mark-prefix files dired-mark-postfix)))
733 (funcall stuff-it files)))
734 (if in-background "&" ""))))
dd87891b
RS
735
736;; This is an extra function so that it can be redefined by ange-ftp.
05dcf18a 737;;;###autoload
6482fcac 738(defun dired-run-shell-command (command)
95ffcc7f
DL
739 (let ((handler
740 (find-file-name-handler (directory-file-name default-directory)
741 'shell-command)))
742 (if handler (apply handler 'shell-command (list command))
743 (shell-command command)))
6482fcac
RS
744 ;; Return nil for sake of nconc in dired-bunch-files.
745 nil)
83fadedf 746\f
dd87891b
RS
747
748(defun dired-check-process (msg program &rest arguments)
749; "Display MSG while running PROGRAM, and check for output.
750;Remaining arguments are strings passed as command arguments to PROGRAM.
751; On error, insert output
752; in a log buffer and return the offending ARGUMENTS or PROGRAM.
753; Caller can cons up a list of failed args.
754;Else returns nil for success."
755 (let (err-buffer err (dir default-directory))
756 (message "%s..." msg)
757 (save-excursion
758 ;; Get a clean buffer for error output:
759 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
760 (set-buffer err-buffer)
761 (erase-buffer)
762 (setq default-directory dir ; caller's default-directory
4a725859 763 err (not (eq 0 (apply 'process-file program nil t nil arguments))))
dd87891b
RS
764 (if err
765 (progn
766 (dired-log (concat program " " (prin1-to-string arguments) "\n"))
767 (dired-log err-buffer)
768 (or arguments program t))
769 (kill-buffer err-buffer)
770 (message "%s...done" msg)
771 nil))))
83fadedf 772\f
dd87891b
RS
773;; Commands that delete or redisplay part of the dired buffer.
774
dd87891b 775(defun dired-kill-line (&optional arg)
d67f7e1f
LMI
776 "Kill the current line (not the files).
777With a prefix argument, kill that many lines starting with the current line.
778\(A negative argument kills backward.)"
dd87891b
RS
779 (interactive "P")
780 (setq arg (prefix-numeric-value arg))
781 (let (buffer-read-only file)
782 (while (/= 0 arg)
783 (setq file (dired-get-filename nil t))
784 (if (not file)
55535639 785 (error "Can only kill file lines")
dd87891b
RS
786 (save-excursion (and file
787 (dired-goto-subdir file)
788 (dired-kill-subdir)))
9b026d9f 789 (delete-region (line-beginning-position)
dd87891b
RS
790 (progn (forward-line 1) (point)))
791 (if (> arg 0)
792 (setq arg (1- arg))
793 (setq arg (1+ arg))
794 (forward-line -1))))
795 (dired-move-to-filename)))
796
797;;;###autoload
798(defun dired-do-kill-lines (&optional arg fmt)
799 "Kill all marked lines (not the files).
6482fcac 800With a prefix argument, kill that many lines starting with the current line.
769d9ed6
LT
801\(A negative argument kills backward.)
802If you use this command with a prefix argument to kill the line
803for a file that is a directory, which you have inserted in the
804Dired buffer as a subdirectory, then it deletes that subdirectory
805from the buffer as well.
806To kill an entire subdirectory \(without killing its line in the
807parent directory), go to its directory header line and use this
808command with a prefix argument (the value does not matter)."
dd87891b
RS
809 ;; Returns count of killed lines. FMT="" suppresses message.
810 (interactive "P")
6482fcac
RS
811 (if arg
812 (if (dired-get-subdir)
813 (dired-kill-subdir)
814 (dired-kill-line arg))
815 (save-excursion
816 (goto-char (point-min))
769d9ed6
LT
817 (let (buffer-read-only
818 (count 0)
819 (regexp (dired-marker-regexp)))
820 (while (and (not (eobp))
821 (re-search-forward regexp nil t))
822 (setq count (1+ count))
9b026d9f 823 (delete-region (line-beginning-position)
769d9ed6 824 (progn (forward-line 1) (point))))
6482fcac
RS
825 (or (equal "" fmt)
826 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
827 count))))
dd87891b
RS
828
829;;;###end dired-cmd.el
83fadedf 830\f
dd87891b
RS
831;;; 30K
832;;;###begin dired-cp.el
833
834(defun dired-compress ()
835 ;; Compress or uncompress the current file.
836 ;; Return nil for success, offending filename else.
837 (let* (buffer-read-only
bfe81e78
RS
838 (from-file (dired-get-filename))
839 (new-file (dired-compress-file from-file)))
840 (if new-file
53a05194
RS
841 (let ((start (point)))
842 ;; Remove any preexisting entry for the name NEW-FILE.
843 (condition-case nil
844 (dired-remove-entry new-file)
845 (error nil))
846 (goto-char start)
847 ;; Now replace the current line with an entry for NEW-FILE.
848 (dired-update-file-line new-file) nil)
bfe81e78
RS
849 (dired-log (concat "Failed to compress" from-file))
850 from-file)))
851
077d5283
RS
852(defvar dired-compress-file-suffixes
853 '(("\\.gz\\'" "" "gunzip")
854 ("\\.tgz\\'" ".tar" "gunzip")
855 ("\\.Z\\'" "" "uncompress")
856 ;; For .z, try gunzip. It might be an old gzip file,
857 ;; or it might be from compact? pack? (which?) but gunzip handles both.
858 ("\\.z\\'" "" "gunzip")
999bd52a
JL
859 ("\\.dz\\'" "" "dictunzip")
860 ("\\.tbz\\'" ".tar" "bunzip2")
2d938ce7 861 ("\\.bz2\\'" "" "bunzip2")
470bce7d 862 ("\\.xz\\'" "" "unxz")
077d5283
RS
863 ;; This item controls naming for compression.
864 ("\\.tar\\'" ".tgz" nil))
865 "Control changes in file name suffixes for compression and uncompression.
866Each element specifies one transformation rule, and has the form:
867 (REGEXP NEW-SUFFIX PROGRAM)
868The rule applies when the old file name matches REGEXP.
869The new file name is computed by deleting the part that matches REGEXP
870 (as well as anything after that), then adding NEW-SUFFIX in its place.
871If PROGRAM is non-nil, the rule is an uncompression rule,
872and uncompression is done by running PROGRAM.
873Otherwise, the rule is a compression rule, and compression is done with gzip.")
874
d443f37c 875;;;###autoload
bfe81e78
RS
876(defun dired-compress-file (file)
877 ;; Compress or uncompress FILE.
878 ;; Return the name of the compressed or uncompressed file.
eb8c3be9 879 ;; Return nil if no change in files.
077d5283
RS
880 (let ((handler (find-file-name-handler file 'dired-compress-file))
881 suffix newname
882 (suffixes dired-compress-file-suffixes))
883 ;; See if any suffix rule matches this file name.
884 (while suffixes
885 (let (case-fold-search)
886 (if (string-match (car (car suffixes)) file)
887 (setq suffix (car suffixes) suffixes nil))
888 (setq suffixes (cdr suffixes))))
889 ;; If so, compute desired new name.
edb8d73e 890 (if suffix
077d5283
RS
891 (setq newname (concat (substring file 0 (match-beginning 0))
892 (nth 1 suffix))))
bfe81e78
RS
893 (cond (handler
894 (funcall handler 'dired-compress-file file))
895 ((file-symlink-p file)
896 nil)
077d5283
RS
897 ((and suffix (nth 2 suffix))
898 ;; We found an uncompression rule.
53a05194 899 (if (not (dired-check-process (concat "Uncompressing " file)
077d5283
RS
900 (nth 2 suffix) file))
901 newname))
dd87891b 902 (t
077d5283 903 ;;; We don't recognize the file as compressed, so compress it.
e251a1fd
RS
904 ;;; Try gzip; if we don't have that, use compress.
905 (condition-case nil
c8068734
CY
906 (let ((out-name (concat file ".gz")))
907 (and (or (not (file-exists-p out-name))
908 (y-or-n-p
9aea757b
CY
909 (format "File %s already exists. Really compress? "
910 out-name)))
c8068734
CY
911 (not (dired-check-process (concat "Compressing " file)
912 "gzip" "-f" file))
913 (or (file-exists-p out-name)
914 (setq out-name (concat file ".z")))
915 ;; Rename the compressed file to NEWNAME
916 ;; if it hasn't got that name already.
917 (if (and newname (not (equal newname out-name)))
918 (progn
919 (rename-file out-name newname t)
920 newname)
921 out-name)))
e251a1fd
RS
922 (file-error
923 (if (not (dired-check-process (concat "Compressing " file)
924 "compress" "-f" file))
077d5283 925 ;; Don't use NEWNAME with `compress'.
e251a1fd 926 (concat file ".Z"))))))))
83fadedf 927\f
dd87891b
RS
928(defun dired-mark-confirm (op-symbol arg)
929 ;; Request confirmation from the user that the operation described
930 ;; by OP-SYMBOL is to be performed on the marked files.
931 ;; Confirmation consists in a y-or-n question with a file list
932 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
933 ;; The files used are determined by ARG (as in dired-get-marked-files).
7baff557
SM
934 (or (eq dired-no-confirm t)
935 (memq op-symbol dired-no-confirm)
c232fd12
RS
936 ;; Pass t for DISTINGUISH-ONE-MARKED so that a single file which
937 ;; is marked pops up a window. That will help the user see
938 ;; it isn't the current line file.
939 (let ((files (dired-get-marked-files t arg nil t))
2de735de
RS
940 (string (if (eq op-symbol 'compress) "Compress or uncompress"
941 (capitalize (symbol-name op-symbol)))))
dd87891b 942 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
2de735de 943 (concat string " "
dd87891b
RS
944 (dired-mark-prompt arg files) "? ")))))
945
946(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
947; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
948; and display failures.
949
950; FUN takes zero args. It returns non-nil (the offending object, e.g.
951; the short form of the filename) for a failure and probably logs a
952; detailed error explanation using function `dired-log'.
953
954; OP-SYMBOL is a symbol describing the operation performed (e.g.
955; `compress'). It is used with `dired-mark-pop-up' to prompt the user
956; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
957; `Failed to compress 1 of 2 files - type W to see why ("foo")')
958
959; SHOW-PROGRESS if non-nil means redisplay dired after each file."
960 (if (dired-mark-confirm op-symbol arg)
961 (let* ((total-list;; all of FUN's return values
962 (dired-map-over-marks (funcall fun) arg show-progress))
963 (total (length total-list))
964 (failures (delq nil total-list))
2de735de
RS
965 (count (length failures))
966 (string (if (eq op-symbol 'compress) "Compress or uncompress"
967 (capitalize (symbol-name op-symbol)))))
dd87891b
RS
968 (if (not failures)
969 (message "%s: %d file%s."
2de735de 970 string total (dired-plural-s total))
dd87891b
RS
971 ;; end this bunch of errors:
972 (dired-log-summary
973 (format "Failed to %s %d of %d file%s"
2de735de 974 (downcase string) count total (dired-plural-s total))
dd87891b
RS
975 failures)))))
976
05dcf18a 977;;;###autoload
3ef01959
CY
978(defun dired-query (sym prompt &rest args)
979 "Format PROMPT with ARGS, query user, and store the result in SYM.
980The return value is either nil or t.
981
982The user may type y or SPC to accept once; n or DEL to skip once;
983! to accept this and subsequent queries; or q or ESC to decline
984this and subsequent queries.
985
986If SYM is already bound to a non-nil value, this function may
987return automatically without querying the user. If SYM is !,
988return t; if SYM is q or ESC, return nil."
989 (let* ((char (symbol-value sym))
990 (char-choices '(?y ?\s ?n ?\177 ?! ?q ?\e)))
991 (cond ((eq char ?!)
992 t) ; accept, and don't ask again
993 ((memq char '(?q ?\e))
994 nil) ; skip, and don't ask again
995 (t ; no previous answer - ask now
996 (setq prompt
997 (concat (apply 'format prompt args)
998 (if help-form
999 (format " [Type yn!q or %s] "
6131ba7f 1000 (key-description (vector help-char)))
3ef01959
CY
1001 " [Type y, n, q or !] ")))
1002 (set sym (setq char (read-char-choice prompt char-choices)))
1003 (if (memq char '(?y ?\s ?!)) t)))))
1004
83fadedf 1005\f
dd87891b
RS
1006;;;###autoload
1007(defun dired-do-compress (&optional arg)
1008 "Compress or uncompress marked (or next ARG) files."
1009 (interactive "P")
1010 (dired-map-over-marks-check (function dired-compress) arg 'compress t))
1011
1012;; Commands for Emacs Lisp files - load and byte compile
1013
1014(defun dired-byte-compile ()
1015 ;; Return nil for success, offending file name else.
1016 (let* ((filename (dired-get-filename))
123ec94d 1017 elc-file buffer-read-only failure)
dd87891b
RS
1018 (condition-case err
1019 (save-excursion (byte-compile-file filename))
1020 (error
1021 (setq failure err)))
123ec94d 1022 (setq elc-file (byte-compile-dest-file filename))
d5b876ef
RS
1023 (or (file-exists-p elc-file)
1024 (setq failure t))
dd87891b
RS
1025 (if failure
1026 (progn
1027 (dired-log "Byte compile error for %s:\n%s\n" filename failure)
1028 (dired-make-relative filename))
1029 (dired-remove-file elc-file)
1030 (forward-line) ; insert .elc after its .el file
1031 (dired-add-file elc-file)
1032 nil)))
1033
1034;;;###autoload
1035(defun dired-do-byte-compile (&optional arg)
1036 "Byte compile marked (or next ARG) Emacs Lisp files."
1037 (interactive "P")
1038 (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
1039
1040(defun dired-load ()
1041 ;; Return nil for success, offending file name else.
1042 (let ((file (dired-get-filename)) failure)
1043 (condition-case err
1044 (load file nil nil t)
1045 (error (setq failure err)))
1046 (if (not failure)
1047 nil
1048 (dired-log "Load error for %s:\n%s\n" file failure)
1049 (dired-make-relative file))))
1050
1051;;;###autoload
1052(defun dired-do-load (&optional arg)
1053 "Load the marked (or next ARG) Emacs Lisp files."
1054 (interactive "P")
1055 (dired-map-over-marks-check (function dired-load) arg 'load t))
1056
1057;;;###autoload
1058(defun dired-do-redisplay (&optional arg test-for-subdir)
1059 "Redisplay all marked (or next ARG) files.
1060If on a subdir line, redisplay that subdirectory. In that case,
79d123ad
LT
1061a prefix arg lets you edit the `ls' switches used for the new listing.
1062
1063Dired remembers switches specified with a prefix arg, so that reverting
1064the buffer will not reset them. However, using `dired-undo' to re-insert
1065or delete subdirectories can bypass this machinery. Hence, you sometimes
1066may have to reset some subdirectory switches after a `dired-undo'.
1067You can reset all subdirectory switches to the default using
fad9e9b4 1068\\<dired-mode-map>\\[dired-reset-subdir-switches].
098c61f2 1069See Info node `(emacs)Subdir switches' for more details."
dd87891b
RS
1070 ;; Moves point if the next ARG files are redisplayed.
1071 (interactive "P\np")
1072 (if (and test-for-subdir (dired-get-subdir))
f2260f48
LT
1073 (let* ((dir (dired-get-subdir))
1074 (switches (cdr (assoc-string dir dired-switches-alist))))
1075 (dired-insert-subdir
1076 dir
1077 (when arg
1078 (read-string "Switches for listing: "
1079 (or switches
1080 dired-subdir-switches
1081 dired-actual-switches)))))
dd87891b
RS
1082 (message "Redisplaying...")
1083 ;; message much faster than making dired-map-over-marks show progress
00aa3651
RS
1084 (dired-uncache
1085 (if (consp dired-directory) (car dired-directory) dired-directory))
86a6e8e0 1086 (dired-map-over-marks (let ((fname (dired-get-filename))
9173deec 1087 ;; Postpone readin hook till we map
86a6e8e0
LL
1088 ;; over all marked files (Bug#6810).
1089 (dired-after-readin-hook nil))
dd87891b
RS
1090 (message "Redisplaying... %s" fname)
1091 (dired-update-file-line fname))
1092 arg)
86a6e8e0 1093 (run-hooks 'dired-after-readin-hook)
dd87891b
RS
1094 (dired-move-to-filename)
1095 (message "Redisplaying...done")))
79d123ad
LT
1096
1097(defun dired-reset-subdir-switches ()
1098 "Set `dired-switches-alist' to nil and revert dired buffer."
1099 (interactive)
1100 (setq dired-switches-alist nil)
1101 (revert-buffer))
83fadedf 1102\f
dd87891b
RS
1103(defun dired-update-file-line (file)
1104 ;; Delete the current line, and insert an entry for FILE.
1105 ;; If FILE is nil, then just delete the current line.
1106 ;; Keeps any marks that may be present in column one (doing this
1107 ;; here is faster than with dired-add-entry's optional arg).
1108 ;; Does not update other dired buffers. Use dired-relist-entry for that.
edb57480
SB
1109 (let* ((opoint (line-beginning-position))
1110 (char (char-after opoint))
1111 (buffer-read-only))
9b026d9f 1112 (delete-region opoint (progn (forward-line 1) (point)))
dd87891b
RS
1113 (if file
1114 (progn
24193f35 1115 (dired-add-entry file nil t)
dd87891b
RS
1116 ;; Replace space by old marker without moving point.
1117 ;; Faster than goto+insdel inside a save-excursion?
1118 (subst-char-in-region opoint (1+ opoint) ?\040 char))))
1119 (dired-move-to-filename))
1120
d443f37c 1121;;;###autoload
dd87891b
RS
1122(defun dired-add-file (filename &optional marker-char)
1123 (dired-fun-in-all-buffers
b2a59df0 1124 (file-name-directory filename) (file-name-nondirectory filename)
dd87891b
RS
1125 (function dired-add-entry) filename marker-char))
1126
30abce25
GM
1127(defvar dired-omit-mode)
1128(declare-function dired-omit-regexp "dired-x" ())
1129(defvar dired-omit-localp)
1130
24193f35 1131(defun dired-add-entry (filename &optional marker-char relative)
30abce25
GM
1132 "Add a new dired entry for FILENAME.
1133Optionally mark it with MARKER-CHAR (a character, else uses
1134`dired-marker-char'). Note that this adds the entry `out of order'
1135if files are sorted by time, etc.
1136Skips files that match `dired-trivial-filenames'.
1137Exposes hidden subdirectories if a file is added there.
1138
1139If `dired-x' is loaded and `dired-omit-mode' is enabled, skips
1140files matching `dired-omit-regexp'."
1141 (if (or (not (featurep 'dired-x))
1142 (not dired-omit-mode)
1143 ;; Avoid calling ls for files that are going to be omitted anyway.
1144 (let ((omit-re (dired-omit-regexp)))
1145 (or (string= omit-re "")
1146 (not (string-match omit-re
1147 (cond
1148 ((eq 'no-dir dired-omit-localp)
1149 filename)
1150 ((eq t dired-omit-localp)
1151 (dired-make-relative filename))
1152 (t
1153 (dired-make-absolute
1154 filename
1155 (file-name-directory filename)))))))))
1156 ;; Do it!
1157 (progn
1158 (setq filename (directory-file-name filename))
1159 ;; Entry is always for files, even if they happen to also be directories
1160 (let* ((opoint (point))
1161 (cur-dir (dired-current-directory))
30abce25
GM
1162 (directory (if relative cur-dir (file-name-directory filename)))
1163 reason)
1164 (setq filename
1165 (if relative
1166 (file-relative-name filename directory)
1167 (file-name-nondirectory filename))
1168 reason
1169 (catch 'not-found
1170 (if (string= directory cur-dir)
1171 (progn
1172 (skip-chars-forward "^\r\n")
1173 (if (eq (following-char) ?\r)
1174 (dired-unhide-subdir))
1175 ;; We are already where we should be, except when
1176 ;; point is before the subdir line or its total line.
1177 (let ((p (dired-after-subdir-garbage cur-dir)))
1178 (if (< (point) p)
1179 (goto-char p))))
1180 ;; else try to find correct place to insert
1181 (if (dired-goto-subdir directory)
1182 (progn ;; unhide if necessary
1183 (if (looking-at "\r")
1184 ;; Point is at end of subdir line.
1185 (dired-unhide-subdir))
1186 ;; found - skip subdir and `total' line
1187 ;; and uninteresting files like . and ..
1188 ;; This better not move into the next subdir!
1189 (dired-goto-next-nontrivial-file))
1190 ;; not found
1191 (throw 'not-found "Subdir not found")))
1192 (let (buffer-read-only opoint)
1193 (beginning-of-line)
1194 (setq opoint (point))
1195 ;; Don't expand `.'.
1196 ;; Show just the file name within directory.
1197 (let ((default-directory directory))
1198 (dired-insert-directory
1199 directory
1200 (concat dired-actual-switches " -d")
1201 (list filename)))
1202 (goto-char opoint)
1203 ;; Put in desired marker char.
1204 (when marker-char
1205 (let ((dired-marker-char
1206 (if (integerp marker-char) marker-char
1207 dired-marker-char)))
1208 (dired-mark nil)))
1209 ;; Compensate for a bug in ange-ftp.
1210 ;; It inserts the file's absolute name, rather than
1211 ;; the relative one. That may be hard to fix since it
1212 ;; is probably controlled by something in ftp.
1213 (goto-char opoint)
1214 (let ((inserted-name (dired-get-filename 'verbatim)))
1215 (if (file-name-directory inserted-name)
1216 (let (props)
1217 (end-of-line)
1218 (forward-char (- (length inserted-name)))
1219 (setq props (text-properties-at (point)))
1220 (delete-char (length inserted-name))
1221 (let ((pt (point)))
1222 (insert filename)
1223 (set-text-properties pt (point) props))
1224 (forward-char 1))
1225 (forward-line 1)))
1226 (forward-line -1)
1227 (if dired-after-readin-hook
1228 ;; The subdir-alist is not affected...
1229 (save-excursion ; ...so we can run it right now:
1230 (save-restriction
1231 (beginning-of-line)
1232 (narrow-to-region (point)
1233 (line-beginning-position 2))
1234 (run-hooks 'dired-after-readin-hook))))
1235 (dired-move-to-filename))
1236 ;; return nil if all went well
1237 nil))
1238 (if reason ; don't move away on failure
1239 (goto-char opoint))
1240 (not reason))) ; return t on success, nil else
1241 ;; Don't do it (dired-omit-mode).
1242 ;; Return t for success (perhaps we should return file-exists-p).
1243 t))
dd87891b 1244
dd87891b
RS
1245(defun dired-after-subdir-garbage (dir)
1246 ;; Return pos of first file line of DIR, skipping header and total
1247 ;; or wildcard lines.
1248 ;; Important: never moves into the next subdir.
1249 ;; DIR is assumed to be unhidden.
dd87891b
RS
1250 (save-excursion
1251 (or (dired-goto-subdir dir) (error "This cannot happen"))
1252 (forward-line 1)
1253 (while (and (not (eolp)) ; don't cross subdir boundary
1254 (not (dired-move-to-filename)))
1255 (forward-line 1))
1256 (point)))
1257
d443f37c 1258;;;###autoload
dd87891b
RS
1259(defun dired-remove-file (file)
1260 (dired-fun-in-all-buffers
b2a59df0
RS
1261 (file-name-directory file) (file-name-nondirectory file)
1262 (function dired-remove-entry) file))
dd87891b
RS
1263
1264(defun dired-remove-entry (file)
1265 (save-excursion
1266 (and (dired-goto-file file)
1267 (let (buffer-read-only)
1268 (delete-region (progn (beginning-of-line) (point))
9b026d9f 1269 (line-beginning-position 2))))))
dd87891b 1270
d443f37c 1271;;;###autoload
dd87891b 1272(defun dired-relist-file (file)
e5369aad 1273 "Create or update the line for FILE in all Dired buffers it would belong in."
dd87891b 1274 (dired-fun-in-all-buffers (file-name-directory file)
b2a59df0 1275 (file-name-nondirectory file)
dd87891b
RS
1276 (function dired-relist-entry) file))
1277
1278(defun dired-relist-entry (file)
1279 ;; Relist the line for FILE, or just add it if it did not exist.
57dabf6b 1280 ;; FILE must be an absolute file name.
dd87891b
RS
1281 (let (buffer-read-only marker)
1282 ;; If cursor is already on FILE's line delete-region will cause
1283 ;; save-excursion to fail because of floating makers,
1284 ;; moving point to beginning of line. Sigh.
1285 (save-excursion
1286 (and (dired-goto-file file)
1287 (delete-region (progn (beginning-of-line)
1288 (setq marker (following-char))
1289 (point))
9b026d9f 1290 (line-beginning-position 2)))
dd87891b
RS
1291 (setq file (directory-file-name file))
1292 (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
83fadedf 1293\f
dd87891b
RS
1294;;; Copy, move/rename, making hard and symbolic links
1295
91a7e829 1296(defcustom dired-backup-overwrite nil
9201cc28 1297 "Non-nil if Dired should ask about making backups before overwriting files.
91a7e829
RS
1298Special value `always' suppresses confirmation."
1299 :type '(choice (const :tag "off" nil)
1300 (const :tag "suppress" always)
a9e9b8fa 1301 (other :tag "ask" t))
91a7e829 1302 :group 'dired)
dd87891b 1303
bf0de14d
CY
1304;; This is a fluid var used in dired-handle-overwrite. It should be
1305;; let-bound whenever dired-copy-file etc are called. See
1306;; dired-create-files for an example.
1307(defvar dired-overwrite-confirmed)
6482fcac 1308
dd87891b 1309(defun dired-handle-overwrite (to)
e5369aad 1310 ;; Save old version of file TO that is to be overwritten.
6482fcac 1311 ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
dd87891b 1312 ;; from dired-create-files.
d63a6ae0 1313 (let (backup)
bbfe2308
CY
1314 (when (and dired-backup-overwrite
1315 dired-overwrite-confirmed
1316 (setq backup (car (find-backup-file-name to)))
1317 (or (eq 'always dired-backup-overwrite)
1318 (dired-query 'overwrite-backup-query
1319 "Make backup for existing file `%s'? "
1320 to)))
1321 (rename-file to backup 0) ; confirm overwrite of old backup
1322 (dired-relist-entry backup))))
dd87891b 1323
d443f37c 1324;;;###autoload
dd87891b
RS
1325(defun dired-copy-file (from to ok-flag)
1326 (dired-handle-overwrite to)
c62a8073
RS
1327 (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
1328 dired-recursive-copies))
dd87891b 1329
8e845e23
JB
1330(declare-function make-symbolic-link "fileio.c")
1331
ba1acd68
RS
1332(defun dired-copy-file-recursive (from to ok-flag &optional
1333 preserve-time top recursive)
40311efc 1334 (when (and (eq t (car (file-attributes from)))
42ee526b 1335 (file-in-directory-p to from))
25b2e303 1336 (error "Cannot copy `%s' into its subdirectory `%s'" from to))
06b60517 1337 (let ((attrs (file-attributes from)))
3b68c506
RS
1338 (if (and recursive
1339 (eq t (car attrs))
1340 (or (eq recursive 'always)
ce5a3ac0 1341 (yes-or-no-p (format "Recursive copies of %s? " from))))
3b68c506 1342 ;; This is a directory.
06b60517 1343 (copy-directory from to preserve-time)
3b68c506
RS
1344 ;; Not a directory.
1345 (or top (dired-handle-overwrite to))
c62a8073
RS
1346 (condition-case err
1347 (if (stringp (car attrs))
1348 ;; It is a symlink
1349 (make-symbolic-link (car attrs) to ok-flag)
06b60517 1350 (copy-file from to ok-flag preserve-time))
4a725859 1351 (file-date-error
c62a8073
RS
1352 (push (dired-make-relative from)
1353 dired-create-files-failures)
7a547817 1354 (dired-log "Can't set date on %s:\n%s\n" from err))))))
ba1acd68 1355
d443f37c 1356;;;###autoload
e5369aad
RS
1357(defun dired-rename-file (file newname ok-if-already-exists)
1358 (dired-handle-overwrite newname)
1359 (rename-file file newname ok-if-already-exists) ; error is caught in -create-files
dd87891b 1360 ;; Silently rename the visited file of any buffer visiting this file.
e5369aad
RS
1361 (and (get-file-buffer file)
1362 (with-current-buffer (get-file-buffer file)
1363 (set-visited-file-name newname nil t)))
1364 (dired-remove-file file)
dd87891b 1365 ;; See if it's an inserted subdir, and rename that, too.
e5369aad 1366 (dired-rename-subdir file newname))
dd87891b
RS
1367
1368(defun dired-rename-subdir (from-dir to-dir)
1369 (setq from-dir (file-name-as-directory from-dir)
1370 to-dir (file-name-as-directory to-dir))
b2a59df0 1371 (dired-fun-in-all-buffers from-dir nil
dd87891b
RS
1372 (function dired-rename-subdir-1) from-dir to-dir)
1373 ;; Update visited file name of all affected buffers
9df38cef
RS
1374 (let ((expanded-from-dir (expand-file-name from-dir))
1375 (blist (buffer-list)))
dd87891b 1376 (while blist
7fdbcd83 1377 (with-current-buffer (car blist)
dd87891b 1378 (if (and buffer-file-name
9df38cef 1379 (dired-in-this-tree buffer-file-name expanded-from-dir))
dd87891b 1380 (let ((modflag (buffer-modified-p))
83fadedf 1381 (to-file (dired-replace-in-string
dd87891b
RS
1382 (concat "^" (regexp-quote from-dir))
1383 to-dir
1384 buffer-file-name)))
1385 (set-visited-file-name to-file)
1386 (set-buffer-modified-p modflag))))
1387 (setq blist (cdr blist)))))
1388
1389(defun dired-rename-subdir-1 (dir to)
1390 ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
1391 ;; one of its subdirectories is expanded in this buffer.
9df38cef
RS
1392 (let ((expanded-dir (expand-file-name dir))
1393 (alist dired-subdir-alist)
dd87891b
RS
1394 (elt nil))
1395 (while alist
1396 (setq elt (car alist)
1397 alist (cdr alist))
9df38cef 1398 (if (dired-in-this-tree (car elt) expanded-dir)
dd87891b
RS
1399 ;; ELT's subdir is affected by the rename
1400 (dired-rename-subdir-2 elt dir to)))
1401 (if (equal dir default-directory)
1402 ;; if top level directory was renamed, lots of things have to be
1403 ;; updated:
1404 (progn
1405 (dired-unadvertise dir) ; we no longer dired DIR...
1406 (setq default-directory to
1407 dired-directory (expand-file-name;; this is correct
1408 ;; with and without wildcards
1409 (file-name-nondirectory dired-directory)
1410 to))
1411 (let ((new-name (file-name-nondirectory
1412 (directory-file-name dired-directory))))
1413 ;; try to rename buffer, but just leave old name if new
1414 ;; name would already exist (don't try appending "<%d>")
1415 (or (get-buffer new-name)
1416 (rename-buffer new-name)))
1417 ;; ... we dired TO now:
1418 (dired-advertise)))))
1419
1420(defun dired-rename-subdir-2 (elt dir to)
f2260f48
LT
1421 ;; Update the headerline and dired-subdir-alist element, as well as
1422 ;; dired-switches-alist element, of directory described by
1423 ;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT
1424 ;; describes either DIR itself or a subdir of DIR.
dd87891b
RS
1425 (save-excursion
1426 (let ((regexp (regexp-quote (directory-file-name dir)))
1427 (newtext (directory-file-name to))
1428 buffer-read-only)
1429 (goto-char (dired-get-subdir-min elt))
1430 ;; Update subdir headerline in buffer
1431 (if (not (looking-at dired-subdir-regexp))
1432 (error "%s not found where expected - dired-subdir-alist broken?"
1433 dir)
1434 (goto-char (match-beginning 1))
1435 (if (re-search-forward regexp (match-end 1) t)
1436 (replace-match newtext t t)
1437 (error "Expected to find `%s' in headerline of %s" dir (car elt))))
f2260f48
LT
1438 ;; Update buffer-local dired-subdir-alist and dired-switches-alist
1439 (let ((cons (assoc-string (car elt) dired-switches-alist))
1440 (cur-dir (dired-normalize-subdir
1441 (dired-replace-in-string regexp newtext (car elt)))))
1442 (setcar elt cur-dir)
1443 (when cons (setcar cons cur-dir))))))
83fadedf 1444\f
06b60517
JB
1445;; Bound in dired-create-files
1446(defvar overwrite-query)
1447(defvar overwrite-backup-query)
1448
dd87891b
RS
1449;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
1450(defun dired-create-files (file-creator operation fn-list name-constructor
1451 &optional marker-char)
0d9e9a12
CY
1452 "Create one or more new files from a list of existing files FN-LIST.
1453This function also handles querying the user, updating Dired
1454buffers, and displaying a success or failure message.
dd87891b 1455
0d9e9a12
CY
1456FILE-CREATOR should be a function. It is called once for each
1457file in FN-LIST, and must create a new file, querying the user
1458and updating Dired buffers as necessary. It should accept three
1459arguments: the old file name, the new name, and an argument
1460OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'.
dd87891b 1461
0d9e9a12
CY
1462OPERATION should be a capitalized string describing the operation
1463performed (e.g. `Copy'). It is used for error logging.
dd87891b 1464
0d9e9a12 1465FN-LIST is the list of files to copy (full absolute file names).
dd87891b 1466
0d9e9a12
CY
1467NAME-CONSTRUCTOR should be a function accepting a single
1468argument, the name of an old file, and returning either the
1469corresponding new file name or nil to skip.
dd87891b 1470
c5695d1d
CY
1471If optional argument MARKER-CHAR is non-nil, mark each
1472newly-created file's Dired entry with the character MARKER-CHAR,
1473or with the current marker character if MARKER-CHAR is t."
c62a8073
RS
1474 (let (dired-create-files-failures failures
1475 skipped (success-count 0) (total (length fn-list)))
dd87891b
RS
1476 (let (to overwrite-query
1477 overwrite-backup-query) ; for dired-handle-overwrite
04509548
SM
1478 (dolist (from fn-list)
1479 (setq to (funcall name-constructor from))
1480 (if (equal to from)
1481 (progn
1482 (setq to nil)
1483 (dired-log "Cannot %s to same file: %s\n"
1484 (downcase operation) from)))
1485 (if (not to)
1486 (setq skipped (cons (dired-make-relative from) skipped))
1487 (let* ((overwrite (file-exists-p to))
1488 (dired-overwrite-confirmed ; for dired-handle-overwrite
1489 (and overwrite
1490 (let ((help-form '(format "\
dd87891b
RS
1491Type SPC or `y' to overwrite file `%s',
1492DEL or `n' to skip to next,
1493ESC or `q' to not overwrite any of the remaining files,
1494`!' to overwrite all remaining files with no more questions." to)))
04509548
SM
1495 (dired-query 'overwrite-query
1496 "Overwrite `%s'?" to))))
1497 ;; must determine if FROM is marked before file-creator
1498 ;; gets a chance to delete it (in case of a move).
1499 (actual-marker-char
1500 (cond ((integerp marker-char) marker-char)
1501 (marker-char (dired-file-marker from)) ; slow
1502 (t nil))))
25b2e303 1503 ;; Handle the `dired-copy-file' file-creator specially
1504 ;; When copying a directory to another directory or
1505 ;; possibly to itself or one of its subdirectories.
1506 ;; e.g "~/foo/" => "~/test/"
1507 ;; or "~/foo/" =>"~/foo/"
1508 ;; or "~/foo/ => ~/foo/bar/")
1509 ;; In this case the 'name-constructor' have set the destination
1510 ;; TO to "~/test/foo" because the old emacs23 behavior
1511 ;; of `copy-directory' was to not create the subdirectory
1512 ;; and instead copy the contents.
1513 ;; With the new behavior of `copy-directory'
1514 ;; (similar to the `cp' shell command) we don't
1515 ;; need such a construction of the target directory,
1516 ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
1517 (let ((destname (file-name-directory to)))
1518 (when (and (file-directory-p from)
1519 (file-directory-p to)
1520 (eq file-creator 'dired-copy-file))
1521 (setq to destname))
40311efc
TV
1522 ;; If DESTNAME is a subdirectory of FROM, not a symlink,
1523 ;; and the method in use is copying, signal an error.
1524 (and (eq t (car (file-attributes destname)))
1525 (eq file-creator 'dired-copy-file)
42ee526b 1526 (file-in-directory-p destname from)
7d0c323f 1527 (error "Cannot copy `%s' into its subdirectory `%s'"
40311efc 1528 from to)))
04509548
SM
1529 (condition-case err
1530 (progn
1531 (funcall file-creator from to dired-overwrite-confirmed)
1532 (if overwrite
1533 ;; If we get here, file-creator hasn't been aborted
1534 ;; and the old entry (if any) has to be deleted
1535 ;; before adding the new entry.
1536 (dired-remove-file to))
1537 (setq success-count (1+ success-count))
1538 (message "%s: %d of %d" operation success-count total)
1539 (dired-add-file to actual-marker-char))
1540 (file-error ; FILE-CREATOR aborted
1541 (progn
1542 (push (dired-make-relative from)
1543 failures)
1544 (dired-log "%s `%s' to `%s' failed:\n%s\n"
1545 operation from to err))))))))
dd87891b 1546 (cond
c62a8073
RS
1547 (dired-create-files-failures
1548 (setq failures (nconc failures dired-create-files-failures))
1549 (dired-log-summary
1550 (format "%s failed for %d file%s in %d requests"
1551 operation (length failures)
1552 (dired-plural-s (length failures))
1553 total)
1554 failures))
dd87891b
RS
1555 (failures
1556 (dired-log-summary
1557 (format "%s failed for %d of %d file%s"
c62a8073
RS
1558 operation (length failures)
1559 total (dired-plural-s total))
dd87891b
RS
1560 failures))
1561 (skipped
1562 (dired-log-summary
1563 (format "%s: %d of %d file%s skipped"
1564 operation (length skipped) total
1565 (dired-plural-s total))
1566 skipped))
1567 (t
1568 (message "%s: %s file%s"
1569 operation success-count (dired-plural-s success-count)))))
1570 (dired-move-to-filename))
83fadedf 1571\f
dd87891b 1572(defun dired-do-create-files (op-symbol file-creator operation arg
616e14f4
SM
1573 &optional marker-char op1
1574 how-to)
1575 "Create a new file for each marked file.
c5695d1d
CY
1576Prompt user for a target directory in which to create the new
1577 files. The target may also be a non-directory file, if only
1578 one file is marked. The initial suggestion for target is the
1579 Dired buffer's current directory (or, if `dired-dwim-target' is
1580 non-nil, the current directory of a neighboring Dired window).
616e14f4
SM
1581OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
1582 will determine whether pop-ups are appropriate for this OP-SYMBOL.
1583FILE-CREATOR and OPERATION as in `dired-create-files'.
1584ARG as in `dired-get-marked-files'.
1585Optional arg MARKER-CHAR as in `dired-create-files'.
1586Optional arg OP1 is an alternate form for OPERATION if there is
1587 only one file.
4c36be58 1588Optional arg HOW-TO determines how to treat the target.
9c8f194d
CY
1589 If HOW-TO is nil, use `file-directory-p' to determine if the
1590 target is a directory. If so, the marked file(s) are created
1591 inside that directory. Otherwise, the target is a plain file;
1592 an error is raised unless there is exactly one marked file.
1593 If HOW-TO is t, target is always treated as a plain file.
1594 Otherwise, HOW-TO should be a function of one argument, TARGET.
1595 If its return value is nil, TARGET is regarded as a plain file.
1596 If it return value is a list, TARGET is a generalized
1597 directory (e.g. some sort of archive). The first element of
1598 this list must be a function with at least four arguments:
1599 operation - as OPERATION above.
1600 rfn-list - list of the relative names for the marked files.
1601 fn-list - list of the absolute names for the marked files.
1602 target - the name of the target itself.
616e14f4 1603 The rest of into-dir are optional arguments.
9c8f194d 1604 For any other return value, TARGET is treated as a directory."
dd87891b
RS
1605 (or op1 (setq op1 operation))
1606 (let* ((fn-list (dired-get-marked-files nil arg))
ba1acd68
RS
1607 (rfn-list (mapcar (function dired-make-relative) fn-list))
1608 (dired-one-file ; fluid variable inside dired-create-files
1609 (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
75ab0c79
GM
1610 (target-dir (dired-dwim-target-directory))
1611 (default (and dired-one-file
1612 (expand-file-name (file-name-nondirectory (car fn-list))
1613 target-dir)))
e237085f 1614 (defaults (dired-dwim-target-defaults fn-list target-dir))
ba1acd68 1615 (target (expand-file-name ; fluid variable inside dired-create-files
e237085f
JL
1616 (minibuffer-with-setup-hook
1617 (lambda ()
1618 (set (make-local-variable 'minibuffer-default-add-function) nil)
1619 (setq minibuffer-default defaults))
1620 (dired-mark-read-file-name
1621 (concat (if dired-one-file op1 operation) " %s to: ")
1622 target-dir op-symbol arg rfn-list default))))
325fec3c
EZ
1623 (into-dir (cond ((null how-to)
1624 ;; Allow DOS/Windows users to change the letter
1625 ;; case of a directory. If we don't test these
1626 ;; conditions up front, file-directory-p below
1627 ;; will return t because the filesystem is
1628 ;; case-insensitive, and Emacs will try to move
1629 ;; foo -> foo/foo, which fails.
c60ee5e7 1630 (if (and (memq system-type '(ms-dos windows-nt cygwin))
325fec3c
EZ
1631 (eq op-symbol 'move)
1632 dired-one-file
1633 (string= (downcase
1634 (expand-file-name (car fn-list)))
1635 (downcase
1636 (expand-file-name target)))
1637 (not (string=
1638 (file-name-nondirectory (car fn-list))
1639 (file-name-nondirectory target))))
1640 nil
1641 (file-directory-p target)))
dd87891b
RS
1642 ((eq how-to t) nil)
1643 (t (funcall how-to target)))))
ba1acd68
RS
1644 (if (and (consp into-dir) (functionp (car into-dir)))
1645 (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
1646 (if (not (or dired-one-file into-dir))
1647 (error "Marked %s: target must be a directory: %s" operation target))
1648 ;; rename-file bombs when moving directories unless we do this:
1649 (or into-dir (setq target (directory-file-name target)))
1650 (dired-create-files
1651 file-creator operation fn-list
1652 (if into-dir ; target is a directory
1653 ;; This function uses fluid variable target when called
1654 ;; inside dired-create-files:
1655 (function
1656 (lambda (from)
1657 (expand-file-name (file-name-nondirectory from) target)))
06b60517 1658 (function (lambda (_from) target)))
ba1acd68 1659 marker-char))))
dd87891b
RS
1660
1661;; Read arguments for a marked-files command that wants a file name,
1662;; perhaps popping up the list of marked files.
1663;; ARG is the prefix arg and indicates whether the files came from
1664;; marks (ARG=nil) or a repeat factor (integerp ARG).
1665;; If the current file was used, the list has but one element and ARG
1666;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
64666d2d
MB
1667;; DEFAULT is the default value to return if the user just hits RET;
1668;; if it is omitted or nil, then the name of the directory is used.
dd87891b 1669
64666d2d
MB
1670(defun dired-mark-read-file-name (prompt dir op-symbol arg files
1671 &optional default)
dd87891b
RS
1672 (dired-mark-pop-up
1673 nil op-symbol files
1674 (function read-file-name)
64666d2d 1675 (format prompt (dired-mark-prompt arg files)) dir default))
dd87891b
RS
1676
1677(defun dired-dwim-target-directory ()
1678 ;; Try to guess which target directory the user may want.
e237085f
JL
1679 ;; If there is a dired buffer displayed in one of the next windows,
1680 ;; use its current subdir, else use current subdir of this dired buffer.
dd87891b
RS
1681 (let ((this-dir (and (eq major-mode 'dired-mode)
1682 (dired-current-directory))))
1683 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
1684 (if dired-dwim-target
e237085f
JL
1685 (let* ((other-win (get-window-with-predicate
1686 (lambda (window)
1687 (with-current-buffer (window-buffer window)
1688 (eq major-mode 'dired-mode)))))
1689 (other-dir (and other-win
1690 (with-current-buffer (window-buffer other-win)
1691 (and (eq major-mode 'dired-mode)
1692 (dired-current-directory))))))
dd87891b
RS
1693 (or other-dir this-dir))
1694 this-dir)))
e237085f
JL
1695
1696(defun dired-dwim-target-defaults (fn-list target-dir)
1697 ;; Return a list of default values for file-reading functions in Dired.
1698 ;; This list may contain directories from Dired buffers in other windows.
1699 ;; `fn-list' is a list of file names used to build a list of defaults.
1700 ;; When nil or more than one element, a list of defaults will
1701 ;; contain only directory names. `target-dir' is a directory name
1702 ;; to exclude from the returned list, for the case when this
1703 ;; directory name is already presented in initial input.
1704 ;; For Dired operations that support `dired-dwim-target',
1705 ;; the argument `target-dir' should have the value returned
1706 ;; from `dired-dwim-target-directory'.
1707 (let ((dired-one-file
1708 (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
1709 (current-dir (and (eq major-mode 'dired-mode)
1710 (dired-current-directory)))
1711 dired-dirs)
1712 ;; Get a list of directories of visible buffers in dired-mode.
1713 (walk-windows (lambda (w)
1714 (with-current-buffer (window-buffer w)
1715 (and (eq major-mode 'dired-mode)
1716 (push (dired-current-directory) dired-dirs)))))
1717 ;; Force the current dir to be the first in the list.
1718 (setq dired-dirs
1719 (delete-dups (delq nil (cons current-dir (nreverse dired-dirs)))))
1720 ;; Remove the target dir (if specified) or the current dir from
1721 ;; default values, because it should be already in initial input.
1722 (setq dired-dirs (delete (or target-dir current-dir) dired-dirs))
1723 ;; Return a list of default values.
1724 (if dired-one-file
1725 ;; For one file operation, provide a list that contains
1726 ;; other directories, other directories with the appended filename
1727 ;; and the current directory with the appended filename, e.g.
1728 ;; 1. /TARGET-DIR/
1729 ;; 2. /TARGET-DIR/FILENAME
1730 ;; 3. /CURRENT-DIR/FILENAME
1731 (append dired-dirs
1732 (mapcar (lambda (dir)
1733 (expand-file-name
1734 (file-name-nondirectory (car fn-list)) dir))
1735 (reverse dired-dirs))
1736 (list (expand-file-name
1737 (file-name-nondirectory (car fn-list))
1738 (or target-dir current-dir))))
1739 ;; For multi-file operation, return only a list of other directories.
1740 dired-dirs)))
1741
83fadedf 1742\f
dd87891b
RS
1743;;;###autoload
1744(defun dired-create-directory (directory)
ff854b0b
CY
1745 "Create a directory called DIRECTORY.
1746If DIRECTORY already exists, signal an error."
dd87891b
RS
1747 (interactive
1748 (list (read-file-name "Create directory: " (dired-current-directory))))
934b4968
JL
1749 (let* ((expanded (directory-file-name (expand-file-name directory)))
1750 (try expanded) new)
ff854b0b
CY
1751 (if (file-exists-p expanded)
1752 (error "Cannot create directory %s: file exists" expanded))
934b4968
JL
1753 ;; Find the topmost nonexistent parent dir (variable `new')
1754 (while (and try (not (file-exists-p try)) (not (equal new try)))
1755 (setq new try
1756 try (directory-file-name (file-name-directory try))))
1757 (make-directory expanded t)
1758 (when new
1759 (dired-add-file new)
1760 (dired-move-to-filename))))
dd87891b
RS
1761
1762(defun dired-into-dir-with-symlinks (target)
1763 (and (file-directory-p target)
1764 (not (file-symlink-p target))))
1765;; This may not always be what you want, especially if target is your
1766;; home directory and it happens to be a symbolic link, as is often the
1767;; case with NFS and automounters. Or if you want to make symlinks
1768;; into directories that themselves are only symlinks, also quite
1769;; common.
1770
1771;; So we don't use this function as value for HOW-TO in
1772;; dired-do-symlink, which has the minor disadvantage of
1773;; making links *into* a symlinked-dir, when you really wanted to
1774;; *overwrite* that symlink. In that (rare, I guess) case, you'll
1775;; just have to remove that symlink by hand before making your marked
1776;; symlinks.
1777
ba1acd68 1778(defvar dired-copy-how-to-fn nil
5a0c3f56 1779 "Either nil or a function used by `dired-do-copy' to determine target.
ba1acd68
RS
1780See HOW-TO argument for `dired-do-create-files'.")
1781
dd87891b
RS
1782;;;###autoload
1783(defun dired-do-copy (&optional arg)
1784 "Copy all marked (or next ARG) files, or copy the current file.
c5695d1d 1785When operating on just the current file, prompt for the new name.
ec9581d5 1786
c5695d1d
CY
1787When operating on multiple or marked files, prompt for a target
1788directory, and make the new copies in that directory, with the
1789same names as the original files. The initial suggestion for the
1790target directory is the Dired buffer's current directory (or, if
1791`dired-dwim-target' is non-nil, the current directory of a
1792neighboring Dired window).
1793
1794If `dired-copy-preserve-time' is non-nil, this command preserves
1795the modification time of each old file in the copy, similar to
1796the \"-p\" option for the \"cp\" shell command.
1797
1798This command copies symbolic links by creating new ones, similar
1799to the \"-d\" option for the \"cp\" shell command."
dd87891b 1800 (interactive "P")
ea185644 1801 (let ((dired-recursive-copies dired-recursive-copies))
ba1acd68 1802 (dired-do-create-files 'copy (function dired-copy-file)
de97d5e8 1803 "Copy"
ea185644
GM
1804 arg dired-keep-marker-copy
1805 nil dired-copy-how-to-fn)))
dd87891b
RS
1806
1807;;;###autoload
1808(defun dired-do-symlink (&optional arg)
1809 "Make symbolic links to current file or all marked (or next ARG) files.
1810When operating on just the current file, you specify the new name.
1811When operating on multiple or marked files, you specify a directory
1812and new symbolic links are made in that directory
dcaf31d3
EZ
1813with the same names that the files currently have. The default
1814suggested for the target directory depends on the value of
806f34d6
EZ
1815`dired-dwim-target', which see.
1816
1817For relative symlinks, use \\[dired-do-relsymlink]."
dd87891b
RS
1818 (interactive "P")
1819 (dired-do-create-files 'symlink (function make-symbolic-link)
1820 "Symlink" arg dired-keep-marker-symlink))
1821
1822;;;###autoload
1823(defun dired-do-hardlink (&optional arg)
1824 "Add names (hard links) current file or all marked (or next ARG) files.
1825When operating on just the current file, you specify the new name.
1826When operating on multiple or marked files, you specify a directory
1827and new hard links are made in that directory
dcaf31d3
EZ
1828with the same names that the files currently have. The default
1829suggested for the target directory depends on the value of
1830`dired-dwim-target', which see."
dd87891b 1831 (interactive "P")
e5369aad 1832 (dired-do-create-files 'hardlink (function dired-hardlink)
dd87891b
RS
1833 "Hardlink" arg dired-keep-marker-hardlink))
1834
e5369aad
RS
1835(defun dired-hardlink (file newname &optional ok-if-already-exists)
1836 (dired-handle-overwrite newname)
1837 ;; error is caught in -create-files
1838 (add-name-to-file file newname ok-if-already-exists)
1839 ;; Update the link count
1840 (dired-relist-file file))
1841
dd87891b
RS
1842;;;###autoload
1843(defun dired-do-rename (&optional arg)
1844 "Rename current file or all marked (or next ARG) files.
1845When renaming just the current file, you specify the new name.
dcaf31d3 1846When renaming multiple or marked files, you specify a directory.
e5369aad 1847This command also renames any buffers that are visiting the files.
dcaf31d3
EZ
1848The default suggested for the target directory depends on the value
1849of `dired-dwim-target', which see."
dd87891b
RS
1850 (interactive "P")
1851 (dired-do-create-files 'move (function dired-rename-file)
1852 "Move" arg dired-keep-marker-rename "Rename"))
1853;;;###end dired-cp.el
83fadedf 1854\f
dd87891b
RS
1855;;; 5K
1856;;;###begin dired-re.el
06b60517
JB
1857(defvar rename-regexp-query)
1858
dd87891b 1859(defun dired-do-create-files-regexp
731ffbd9 1860 (file-creator operation arg regexp newname &optional whole-name marker-char)
dd87891b
RS
1861 ;; Create a new file for each marked file using regexps.
1862 ;; FILE-CREATOR and OPERATION as in dired-create-files.
1863 ;; ARG as in dired-get-marked-files.
1864 ;; Matches each marked file against REGEXP and constructs the new
1865 ;; filename from NEWNAME (like in function replace-match).
731ffbd9 1866 ;; Optional arg WHOLE-NAME means match/replace the whole file name
dd87891b
RS
1867 ;; instead of only the non-directory part of the file.
1868 ;; Optional arg MARKER-CHAR as in dired-create-files.
1869 (let* ((fn-list (dired-get-marked-files nil arg))
dd87891b
RS
1870 (operation-prompt (concat operation " `%s' to `%s'?"))
1871 (rename-regexp-help-form (format "\
1872Type SPC or `y' to %s one match, DEL or `n' to skip to next,
1873`!' to %s all remaining matches with no more questions."
1874 (downcase operation)
1875 (downcase operation)))
1876 (regexp-name-constructor
1877 ;; Function to construct new filename using REGEXP and NEWNAME:
731ffbd9 1878 (if whole-name ; easy (but rare) case
dd87891b
RS
1879 (function
1880 (lambda (from)
1881 (let ((to (dired-string-replace-match regexp from newname))
1882 ;; must bind help-form directly around call to
1883 ;; dired-query
1884 (help-form rename-regexp-help-form))
1885 (if to
1886 (and (dired-query 'rename-regexp-query
1887 operation-prompt
1888 from
1889 to)
1890 to)
1891 (dired-log "%s: %s did not match regexp %s\n"
1892 operation from regexp)))))
731ffbd9 1893 ;; not whole-name, replace non-directory part only
dd87891b
RS
1894 (function
1895 (lambda (from)
1896 (let* ((new (dired-string-replace-match
1897 regexp (file-name-nondirectory from) newname))
1898 (to (and new ; nil means there was no match
1899 (expand-file-name new
1900 (file-name-directory from))))
1901 (help-form rename-regexp-help-form))
1902 (if to
1903 (and (dired-query 'rename-regexp-query
1904 operation-prompt
1905 (dired-make-relative from)
1906 (dired-make-relative to))
1907 to)
1908 (dired-log "%s: %s did not match regexp %s\n"
1909 operation (file-name-nondirectory from) regexp)))))))
1910 rename-regexp-query)
1911 (dired-create-files
1912 file-creator operation fn-list regexp-name-constructor marker-char)))
1913
1914(defun dired-mark-read-regexp (operation)
1915 ;; Prompt user about performing OPERATION.
731ffbd9
KS
1916 ;; Read and return list of: regexp newname arg whole-name.
1917 (let* ((whole-name
dd87891b
RS
1918 (equal 0 (prefix-numeric-value current-prefix-arg)))
1919 (arg
731ffbd9 1920 (if whole-name nil current-prefix-arg))
dd87891b
RS
1921 (regexp
1922 (dired-read-regexp
731ffbd9 1923 (concat (if whole-name "Abs. " "") operation " from (regexp): ")))
dd87891b
RS
1924 (newname
1925 (read-string
731ffbd9
KS
1926 (concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
1927 (list regexp newname arg whole-name)))
dd87891b
RS
1928
1929;;;###autoload
731ffbd9 1930(defun dired-do-rename-regexp (regexp newname &optional arg whole-name)
2b3e941a
EZ
1931 "Rename selected files whose names match REGEXP to NEWNAME.
1932
1933With non-zero prefix argument ARG, the command operates on the next ARG
1934files. Otherwise, it operates on all the marked files, or the current
1935file if none are marked.
1936
dd87891b
RS
1937As each match is found, the user must type a character saying
1938 what to do with it. For directions, type \\[help-command] at that time.
1939NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
1940REGEXP defaults to the last regexp used.
57dabf6b
RS
1941
1942With a zero prefix arg, renaming by regexp affects the absolute file name.
1943Normally, only the non-directory part of the file name is used and changed."
dd87891b
RS
1944 (interactive (dired-mark-read-regexp "Rename"))
1945 (dired-do-create-files-regexp
1946 (function dired-rename-file)
731ffbd9 1947 "Rename" arg regexp newname whole-name dired-keep-marker-rename))
dd87891b
RS
1948
1949;;;###autoload
731ffbd9 1950(defun dired-do-copy-regexp (regexp newname &optional arg whole-name)
2b3e941a 1951 "Copy selected files whose names match REGEXP to NEWNAME.
99c364e4 1952See function `dired-do-rename-regexp' for more info."
dd87891b 1953 (interactive (dired-mark-read-regexp "Copy"))
ba1acd68
RS
1954 (let ((dired-recursive-copies nil)) ; No recursive copies.
1955 (dired-do-create-files-regexp
1956 (function dired-copy-file)
1957 (if dired-copy-preserve-time "Copy [-p]" "Copy")
731ffbd9 1958 arg regexp newname whole-name dired-keep-marker-copy)))
dd87891b
RS
1959
1960;;;###autoload
731ffbd9 1961(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name)
2b3e941a 1962 "Hardlink selected files whose names match REGEXP to NEWNAME.
99c364e4 1963See function `dired-do-rename-regexp' for more info."
dd87891b
RS
1964 (interactive (dired-mark-read-regexp "HardLink"))
1965 (dired-do-create-files-regexp
1966 (function add-name-to-file)
731ffbd9 1967 "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
dd87891b
RS
1968
1969;;;###autoload
731ffbd9 1970(defun dired-do-symlink-regexp (regexp newname &optional arg whole-name)
2b3e941a 1971 "Symlink selected files whose names match REGEXP to NEWNAME.
99c364e4 1972See function `dired-do-rename-regexp' for more info."
dd87891b
RS
1973 (interactive (dired-mark-read-regexp "SymLink"))
1974 (dired-do-create-files-regexp
1975 (function make-symbolic-link)
731ffbd9 1976 "SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
dd87891b 1977
06b60517
JB
1978(defvar rename-non-directory-query)
1979
dd87891b
RS
1980(defun dired-create-files-non-directory
1981 (file-creator basename-constructor operation arg)
1982 ;; Perform FILE-CREATOR on the non-directory part of marked files
1983 ;; using function BASENAME-CONSTRUCTOR, with query for each file.
1984 ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
1985 (let (rename-non-directory-query)
1986 (dired-create-files
1987 file-creator
1988 operation
1989 (dired-get-marked-files nil arg)
1990 (function
1991 (lambda (from)
1992 (let ((to (concat (file-name-directory from)
1993 (funcall basename-constructor
1994 (file-name-nondirectory from)))))
1995 (and (let ((help-form (format "\
1996Type SPC or `y' to %s one file, DEL or `n' to skip to next,
1997`!' to %s all remaining matches with no more questions."
1998 (downcase operation)
1999 (downcase operation))))
2000 (dired-query 'rename-non-directory-query
2001 (concat operation " `%s' to `%s'")
2002 (dired-make-relative from)
2003 (dired-make-relative to)))
2004 to))))
2005 dired-keep-marker-rename)))
2006
2007(defun dired-rename-non-directory (basename-constructor operation arg)
2008 (dired-create-files-non-directory
2009 (function dired-rename-file)
2010 basename-constructor operation arg))
2011
2012;;;###autoload
2013(defun dired-upcase (&optional arg)
2014 "Rename all marked (or next ARG) files to upper case."
2015 (interactive "P")
2016 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
2017
2018;;;###autoload
2019(defun dired-downcase (&optional arg)
2020 "Rename all marked (or next ARG) files to lower case."
2021 (interactive "P")
2022 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
2023
2024;;;###end dired-re.el
83fadedf 2025\f
dd87891b
RS
2026;;; 13K
2027;;;###begin dired-ins.el
2028
2029;;;###autoload
2030(defun dired-maybe-insert-subdir (dirname &optional
2031 switches no-error-if-not-dir-p)
2032 "Insert this subdirectory into the same dired buffer.
2033If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
2034 else inserts it at its natural place (as `ls -lR' would have done).
2035With a prefix arg, you may edit the ls switches used for this listing.
2036 You can add `R' to the switches to expand the whole tree starting at
2037 this subdirectory.
79d123ad
LT
2038This function takes some pains to conform to `ls -lR' output.
2039
2040Dired remembers switches specified with a prefix arg, so that reverting
2041the buffer will not reset them. However, using `dired-undo' to re-insert
2042or delete subdirectories can bypass this machinery. Hence, you sometimes
2043may have to reset some subdirectory switches after a `dired-undo'.
2044You can reset all subdirectory switches to the default using
fad9e9b4 2045\\<dired-mode-map>\\[dired-reset-subdir-switches].
098c61f2 2046See Info node `(emacs)Subdir switches' for more details."
dd87891b
RS
2047 (interactive
2048 (list (dired-get-filename)
2049 (if current-prefix-arg
f2260f48
LT
2050 (read-string "Switches for listing: "
2051 (or dired-subdir-switches dired-actual-switches)))))
dd87891b
RS
2052 (let ((opoint (point)))
2053 ;; We don't need a marker for opoint as the subdir is always
2054 ;; inserted *after* opoint.
2055 (setq dirname (file-name-as-directory dirname))
2056 (or (and (not switches)
2057 (dired-goto-subdir dirname))
2058 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
2059 ;; Push mark so that it's easy to find back. Do this after the
2060 ;; insert message so that the user sees the `Mark set' message.
2061 (push-mark opoint)))
2062
72af9867 2063;;;###autoload
dd87891b 2064(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
c5695d1d
CY
2065 "Insert this subdirectory into the same Dired buffer.
2066If it is already present, overwrite the previous entry;
2067 otherwise, insert it at its natural place (as `ls -lR' would
2068 have done).
dd87891b
RS
2069With a prefix arg, you may edit the `ls' switches used for this listing.
2070 You can add `R' to the switches to expand the whole tree starting at
2071 this subdirectory.
2072This function takes some pains to conform to `ls -lR' output."
2073 ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
2074 ;; Prospero where dired-ls does the right thing, but
2075 ;; file-directory-p has not been redefined.
2076 (interactive
2077 (list (dired-get-filename)
2078 (if current-prefix-arg
f2260f48
LT
2079 (read-string "Switches for listing: "
2080 (or dired-subdir-switches dired-actual-switches)))))
dd87891b 2081 (setq dirname (file-name-as-directory (expand-file-name dirname)))
dd87891b
RS
2082 (or no-error-if-not-dir-p
2083 (file-directory-p dirname)
2084 (error "Attempt to insert a non-directory: %s" dirname))
2085 (let ((elt (assoc dirname dired-subdir-alist))
f2260f48
LT
2086 (cons (assoc-string dirname dired-switches-alist))
2087 (modflag (buffer-modified-p))
2088 (old-switches switches)
2089 switches-have-R mark-alist case-fold-search buffer-read-only)
2090 (and (not switches) cons (setq switches (cdr cons)))
2091 (dired-insert-subdir-validate dirname switches)
dd87891b
RS
2092 ;; case-fold-search is nil now, so we can test for capital `R':
2093 (if (setq switches-have-R (and switches (string-match "R" switches)))
2094 ;; avoid duplicated subdirs
2095 (setq mark-alist (dired-kill-tree dirname t)))
2096 (if elt
2097 ;; If subdir is already present, remove it and remember its marks
2098 (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
2099 (dired-insert-subdir-newpos dirname)) ; else compute new position
2100 (dired-insert-subdir-doupdate
2101 dirname elt (dired-insert-subdir-doinsert dirname switches))
f2260f48
LT
2102 (when old-switches
2103 (if cons
2104 (setcdr cons switches)
2105 (push (cons dirname switches) dired-switches-alist)))
2106 (when switches-have-R
2107 (dired-build-subdir-alist switches)
081e4397 2108 (setq switches (dired-replace-in-string "R" "" switches))
f2260f48
LT
2109 (dolist (cur-ass dired-subdir-alist)
2110 (let ((cur-dir (car cur-ass)))
2111 (and (dired-in-this-tree cur-dir dirname)
f2260f48
LT
2112 (let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
2113 (if cur-cons
2114 (setcdr cur-cons switches)
2115 (push (cons cur-dir switches) dired-switches-alist)))))))
dd87891b 2116 (dired-initial-position dirname)
f2260f48
LT
2117 (save-excursion (dired-mark-remembered mark-alist))
2118 (restore-buffer-modified-p modflag)))
dd87891b 2119
dd87891b
RS
2120(defun dired-insert-subdir-validate (dirname &optional switches)
2121 ;; Check that it is valid to insert DIRNAME with SWITCHES.
2122 ;; Signal an error if invalid (e.g. user typed `i' on `..').
d443f37c 2123 (or (dired-in-this-tree dirname (expand-file-name default-directory))
dd87891b 2124 (error "%s: not in this directory tree" dirname))
f2260f48
LT
2125 (let ((real-switches (or switches dired-subdir-switches)))
2126 (when real-switches
dd87891b
RS
2127 (let (case-fold-search)
2128 (mapcar
2129 (function
2130 (lambda (x)
f2260f48 2131 (or (eq (null (string-match x real-switches))
dd87891b 2132 (null (string-match x dired-actual-switches)))
f2260f48
LT
2133 (error
2134 "Can't have dirs with and without -%s switches together" x))))
dd87891b 2135 ;; all switches that make a difference to dired-get-filename:
f2260f48 2136 '("F" "b"))))))
dd87891b
RS
2137
2138(defun dired-alist-add (dir new-marker)
2139 ;; Add new DIR at NEW-MARKER. Sort alist.
2140 (dired-alist-add-1 dir new-marker)
2141 (dired-alist-sort))
2142
2143(defun dired-alist-sort ()
2144 ;; Keep the alist sorted on buffer position.
2145 (setq dired-subdir-alist
2146 (sort dired-subdir-alist
2147 (function (lambda (elt1 elt2)
2148 (> (dired-get-subdir-min elt1)
2149 (dired-get-subdir-min elt2)))))))
2150
0a07c3a9 2151(defun dired-kill-tree (dirname &optional remember-marks kill-root)
616e14f4 2152 "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
0a07c3a9
LT
2153Interactively, you can kill DIRNAME as well by using a prefix argument.
2154In interactive use, the command prompts for DIRNAME.
2155
2156When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
2157of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
2158 (interactive "DKill tree below directory: \ni\nP")
2159 (setq dirname (file-name-as-directory (expand-file-name dirname)))
dd87891b
RS
2160 (let ((s-alist dired-subdir-alist) dir m-alist)
2161 (while s-alist
2162 (setq dir (car (car s-alist))
2163 s-alist (cdr s-alist))
0a07c3a9
LT
2164 (and (or kill-root (not (string-equal dir dirname)))
2165 (dired-in-this-tree dir dirname)
2166 (dired-goto-subdir dir)
2167 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
dd87891b
RS
2168 m-alist))
2169
2170(defun dired-insert-subdir-newpos (new-dir)
2171 ;; Find pos for new subdir, according to tree order.
2172 ;;(goto-char (point-max))
2173 (let ((alist dired-subdir-alist) elt dir pos new-pos)
2174 (while alist
2175 (setq elt (car alist)
2176 alist (cdr alist)
06b60517 2177 dir (car elt))
dd87891b
RS
2178 (if (dired-tree-lessp dir new-dir)
2179 ;; Insert NEW-DIR after DIR
2180 (setq new-pos (dired-get-subdir-max elt)
2181 alist nil)))
2182 (goto-char new-pos))
2183 ;; want a separating newline between subdirs
2184 (or (eobp)
2185 (forward-line -1))
2186 (insert "\n")
2187 (point))
2188
2189(defun dired-insert-subdir-del (element)
2190 ;; Erase an already present subdir (given by ELEMENT) from buffer.
2191 ;; Move to that buffer position. Return a mark-alist.
2192 (let ((begin-marker (dired-get-subdir-min element)))
2193 (goto-char begin-marker)
2194 ;; Are at beginning of subdir (and inside it!). Now determine its end:
2195 (goto-char (dired-subdir-max))
2196 (or (eobp);; want a separating newline _between_ subdirs:
2197 (forward-char -1))
2198 (prog1
2199 (dired-remember-marks begin-marker (point))
2200 (delete-region begin-marker (point)))))
2201
2202(defun dired-insert-subdir-doinsert (dirname switches)
e5369aad 2203 ;; Insert ls output after point.
dd87891b 2204 ;; Return the boundary of the inserted text (as list of BEG and END).
349254d3
AS
2205 (save-excursion
2206 (let ((begin (point)))
349254d3
AS
2207 (let ((dired-actual-switches
2208 (or switches
f2260f48 2209 dired-subdir-switches
349254d3
AS
2210 (dired-replace-in-string "R" "" dired-actual-switches))))
2211 (if (equal dirname (car (car (last dired-subdir-alist))))
2212 ;; If doing the top level directory of the buffer,
2213 ;; redo it as specified in dired-directory.
2214 (dired-readin-insert)
2215 (dired-insert-directory dirname dired-actual-switches nil nil t)))
349254d3 2216 (list begin (point)))))
dd87891b
RS
2217
2218(defun dired-insert-subdir-doupdate (dirname elt beg-end)
2219 ;; Point is at the correct subdir alist position for ELT,
2220 ;; BEG-END is the subdir-region (as list of begin and end).
2221 (if elt ; subdir was already present
2222 ;; update its position (should actually be unchanged)
2223 (set-marker (dired-get-subdir-min elt) (point-marker))
2224 (dired-alist-add dirname (point-marker)))
2225 ;; The hook may depend on the subdir-alist containing the just
2226 ;; inserted subdir, so run it after dired-alist-add:
2227 (if dired-after-readin-hook
2228 (save-excursion
2229 (let ((begin (nth 0 beg-end))
2230 (end (nth 1 beg-end)))
2231 (goto-char begin)
2232 (save-restriction
2233 (narrow-to-region begin end)
2234 ;; hook may add or delete lines, but the subdir boundary
2235 ;; marker floats
2236 (run-hooks 'dired-after-readin-hook))))))
2237
2238(defun dired-tree-lessp (dir1 dir2)
57dabf6b 2239 ;; Lexicographic order on file name components, like `ls -lR':
4837b516
GM
2240 ;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
2241 ;; i.e., if DIR1 is a (grand)parent dir of DIR2,
dd87891b
RS
2242 ;; or DIR1 and DIR2 are in the same parentdir and their last
2243 ;; components are string-lessp.
2244 ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
2245 ;; string-lessp could arguably be replaced by file-newer-than-file-p
2246 ;; if dired-actual-switches contained `t'.
2247 (setq dir1 (file-name-as-directory dir1)
2248 dir2 (file-name-as-directory dir2))
2249 (let ((components-1 (dired-split "/" dir1))
2250 (components-2 (dired-split "/" dir2)))
2251 (while (and components-1
2252 components-2
2253 (equal (car components-1) (car components-2)))
2254 (setq components-1 (cdr components-1)
2255 components-2 (cdr components-2)))
2256 (let ((c1 (car components-1))
2257 (c2 (car components-2)))
2258
2259 (cond ((and c1 c2)
2260 (string-lessp c1 c2))
2261 ((and (null c1) (null c2))
2262 nil) ; they are equal, not lessp
2263 ((null c1) ; c2 is a subdir of c1: c1<c2
2264 t)
2265 ((null c2) ; c1 is a subdir of c2: c1>c2
2266 nil)
2267 (t (error "This can't happen"))))))
2268
2269;; There should be a builtin split function - inverse to mapconcat.
2270(defun dired-split (pat str &optional limit)
2271 "Splitting on regexp PAT, turn string STR into a list of substrings.
2272Optional third arg LIMIT (>= 1) is a limit to the length of the
2273resulting list.
2274Thus, if SEP is a regexp that only matches itself,
2275
2276 (mapconcat 'identity (dired-split SEP STRING) SEP)
2277
2278is always equal to STRING."
2279 (let* ((start (string-match pat str))
2280 (result (list (substring str 0 start)))
2281 (count 1)
2282 (end (if start (match-end 0))))
2283 (if end ; else nothing left
2284 (while (and (or (not (integerp limit))
2285 (< count limit))
2286 (string-match pat str end))
2287 (setq start (match-beginning 0)
2288 count (1+ count)
2289 result (cons (substring str end start) result)
2290 end (match-end 0)
2291 start end)
2292 ))
2293 (if (and (or (not (integerp limit))
2294 (< count limit))
2295 end) ; else nothing left
2296 (setq result
2297 (cons (substring str end) result)))
2298 (nreverse result)))
83fadedf 2299\f
dd87891b
RS
2300;;; moving by subdirectories
2301
dd87891b
RS
2302;;;###autoload
2303(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
2304 "Go to previous subdirectory, regardless of level.
2305When called interactively and not on a subdir line, go to this subdir's line."
2306 ;;(interactive "p")
2307 (interactive
2308 (list (if current-prefix-arg
2309 (prefix-numeric-value current-prefix-arg)
2310 ;; if on subdir start already, don't stay there!
2311 (if (dired-get-subdir) 1 0))))
2312 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
2313
2314(defun dired-subdir-min ()
2315 (save-excursion
2316 (if (not (dired-prev-subdir 0 t t))
2317 (error "Not in a subdir!")
2318 (point))))
2319
2320;;;###autoload
2321(defun dired-goto-subdir (dir)
2322 "Go to end of header line of DIR in this dired buffer.
2323Return value of point on success, otherwise return nil.
2324The next char is either \\n, or \\r if DIR is hidden."
2325 (interactive
2326 (prog1 ; let push-mark display its message
2327 (list (expand-file-name
2328 (completing-read "Goto in situ directory: " ; prompt
2329 dired-subdir-alist ; table
2330 nil ; predicate
2331 t ; require-match
2332 (dired-current-directory))))
2333 (push-mark)))
2334 (setq dir (file-name-as-directory dir))
2335 (let ((elt (assoc dir dired-subdir-alist)))
2336 (and elt
2337 (goto-char (dired-get-subdir-min elt))
2338 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
2339 ;; at either \r or \n after this function succeeds.
2340 (progn (skip-chars-forward "^\r\n")
2341 (point)))))
83fadedf 2342\f
dd87891b
RS
2343;;;###autoload
2344(defun dired-mark-subdir-files ()
472974e9
RS
2345 "Mark all files except `.' and `..' in current subdirectory.
2346If the Dired buffer shows multiple directories, this command
2347marks the files listed in the subdirectory that point is in."
96149b57 2348 (interactive)
dd87891b
RS
2349 (let ((p-min (dired-subdir-min)))
2350 (dired-mark-files-in-region p-min (dired-subdir-max))))
2351
2352;;;###autoload
2353(defun dired-kill-subdir (&optional remember-marks)
2354 "Remove all lines of current subdirectory.
2355Lower levels are unaffected."
2356 ;; With optional REMEMBER-MARKS, return a mark-alist.
2357 (interactive)
f2260f48
LT
2358 (let* ((beg (dired-subdir-min))
2359 (end (dired-subdir-max))
2360 (modflag (buffer-modified-p))
2361 (cur-dir (dired-current-directory))
2362 (cons (assoc-string cur-dir dired-switches-alist))
2363 buffer-read-only)
dd87891b
RS
2364 (if (equal cur-dir default-directory)
2365 (error "Attempt to kill top level directory"))
2366 (prog1
2367 (if remember-marks (dired-remember-marks beg end))
2368 (delete-region beg end)
2369 (if (eobp) ; don't leave final blank line
2370 (delete-char -1))
f2260f48
LT
2371 (dired-unsubdir cur-dir)
2372 (when cons
2373 (setq dired-switches-alist (delete cons dired-switches-alist)))
2374 (restore-buffer-modified-p modflag))))
dd87891b
RS
2375
2376(defun dired-unsubdir (dir)
2377 ;; Remove DIR from the alist
2378 (setq dired-subdir-alist
2379 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
2380
2381;;;###autoload
2382(defun dired-tree-up (arg)
2383 "Go up ARG levels in the dired tree."
2384 (interactive "p")
2385 (let ((dir (dired-current-directory)))
2386 (while (>= arg 1)
2387 (setq arg (1- arg)
2388 dir (file-name-directory (directory-file-name dir))))
2389 ;;(setq dir (expand-file-name dir))
2390 (or (dired-goto-subdir dir)
55535639 2391 (error "Cannot go up to %s - not in this tree" dir))))
dd87891b
RS
2392
2393;;;###autoload
2394(defun dired-tree-down ()
2395 "Go down in the dired tree."
2396 (interactive)
2397 (let ((dir (dired-current-directory)) ; has slash
2398 pos case-fold-search) ; filenames are case sensitive
2399 (let ((rest (reverse dired-subdir-alist)) elt)
2400 (while rest
2401 (setq elt (car rest)
2402 rest (cdr rest))
2403 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
2404 (setq rest nil
2405 pos (dired-goto-subdir (car elt))))))
2406 (if pos
2407 (goto-char pos)
2408 (error "At the bottom"))))
83fadedf 2409\f
dd87891b
RS
2410;;; hiding
2411
2412(defun dired-unhide-subdir ()
2413 (let (buffer-read-only)
2414 (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
2415
2416(defun dired-hide-check ()
2417 (or selective-display
2418 (error "selective-display must be t for subdir hiding to work!")))
2419
2420(defun dired-subdir-hidden-p (dir)
2421 (and selective-display
2422 (save-excursion
2423 (dired-goto-subdir dir)
2424 (looking-at "\r"))))
2425
2426;;;###autoload
2427(defun dired-hide-subdir (arg)
2428 "Hide or unhide the current subdirectory and move to next directory.
2429Optional prefix arg is a repeat factor.
2430Use \\[dired-hide-all] to (un)hide all directories."
2431 (interactive "p")
2432 (dired-hide-check)
f2260f48
LT
2433 (let ((modflag (buffer-modified-p)))
2434 (while (>= (setq arg (1- arg)) 0)
2435 (let* ((cur-dir (dired-current-directory))
2436 (hidden-p (dired-subdir-hidden-p cur-dir))
2437 (elt (assoc cur-dir dired-subdir-alist))
2438 (end-pos (1- (dired-get-subdir-max elt)))
2439 buffer-read-only)
2440 ;; keep header line visible, hide rest
2441 (goto-char (dired-get-subdir-min elt))
2442 (skip-chars-forward "^\n\r")
2443 (if hidden-p
2444 (subst-char-in-region (point) end-pos ?\r ?\n)
2445 (subst-char-in-region (point) end-pos ?\n ?\r)))
2446 (dired-next-subdir 1 t))
2447 (restore-buffer-modified-p modflag)))
dd87891b
RS
2448
2449;;;###autoload
8ae41cbc 2450(defun dired-hide-all (&optional ignored)
dd87891b
RS
2451 "Hide all subdirectories, leaving only their header lines.
2452If there is already something hidden, make everything visible again.
2453Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
2454 (interactive "P")
2455 (dired-hide-check)
f2260f48
LT
2456 (let ((modflag (buffer-modified-p))
2457 buffer-read-only)
dd87891b
RS
2458 (if (save-excursion
2459 (goto-char (point-min))
2460 (search-forward "\r" nil t))
2461 ;; unhide - bombs on \r in filenames
2462 (subst-char-in-region (point-min) (point-max) ?\r ?\n)
2463 ;; hide
2464 (let ((pos (point-max)) ; pos of end of last directory
2465 (alist dired-subdir-alist))
f2260f48 2466 (while alist ; while there are dirs before pos
dd87891b
RS
2467 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
2468 (save-excursion
2469 (goto-char pos) ; current dir
2470 ;; we're somewhere on current dir's line
2471 (forward-line -1)
2472 (point))
2473 ?\n ?\r)
2474 (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
f2260f48
LT
2475 (setq alist (cdr alist)))))
2476 (restore-buffer-modified-p modflag)))
dd87891b
RS
2477
2478;;;###end dired-ins.el
2f14b48d 2479
83fadedf 2480\f
b4b6bda2
JL
2481;; Search only in file names in the Dired buffer.
2482
2483(defcustom dired-isearch-filenames nil
9201cc28 2484 "Non-nil to Isearch in file names only.
b9d9c159
JL
2485If t, Isearch in Dired always matches only file names.
2486If `dwim', Isearch matches file names when initial point position is on
2487a file name. Otherwise, it searches the whole buffer without restrictions."
b4b6bda2 2488 :type '(choice (const :tag "No restrictions" nil)
b9d9c159
JL
2489 (const :tag "When point is on a file name initially, search file names" dwim)
2490 (const :tag "Always search in file names" t))
b4b6bda2
JL
2491 :group 'dired
2492 :version "23.1")
2493
43533626 2494(defvar dired-isearch-filter-predicate-orig nil)
b4b6bda2 2495
f1056735
JL
2496(defun dired-isearch-filenames-toggle ()
2497 "Toggle file names searching on or off.
43533626
JL
2498When on, Isearch skips matches outside file names using the predicate
2499`dired-isearch-filter-filenames' that matches only at file names.
04f0aeaf 2500When off, it uses the original predicate."
f1056735 2501 (interactive)
43533626
JL
2502 (setq isearch-filter-predicate
2503 (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames)
04f0aeaf 2504 dired-isearch-filter-predicate-orig
43533626 2505 'dired-isearch-filter-filenames))
f1056735
JL
2506 (setq isearch-success t isearch-adjusted t)
2507 (isearch-update))
2508
27f7e9b5 2509;;;###autoload
b4b6bda2
JL
2510(defun dired-isearch-filenames-setup ()
2511 "Set up isearch to search in Dired file names.
2512Intended to be added to `isearch-mode-hook'."
b9d9c159
JL
2513 (when (or (eq dired-isearch-filenames t)
2514 (and (eq dired-isearch-filenames 'dwim)
2515 (get-text-property (point) 'dired-filename)))
2516 (setq isearch-message-prefix-add "filename ")
f1056735 2517 (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle)
43533626
JL
2518 (setq dired-isearch-filter-predicate-orig
2519 (default-value 'isearch-filter-predicate))
2520 (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames)
b4b6bda2
JL
2521 (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
2522
2523(defun dired-isearch-filenames-end ()
2524 "Clean up the Dired file name search after terminating isearch."
b9d9c159 2525 (setq isearch-message-prefix-add nil)
f1056735 2526 (define-key isearch-mode-map "\M-sf" nil)
43533626 2527 (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig)
b4b6bda2
JL
2528 (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
2529
43533626 2530(defun dired-isearch-filter-filenames (beg end)
04f0aeaf
JL
2531 "Test whether the current search hit is a visible file name.
2532Return non-nil if the text from BEG to END is part of a file
2533name (has the text property `dired-filename') and is visible."
2534 (and (isearch-filter-visible beg end)
b4b6bda2
JL
2535 (if dired-isearch-filenames
2536 (text-property-not-all (min beg end) (max beg end)
2537 'dired-filename nil)
2538 t)))
2539
2540;;;###autoload
2541(defun dired-isearch-filenames ()
2542 "Search for a string using Isearch only in file names in the Dired buffer."
2543 (interactive)
b9d9c159 2544 (let ((dired-isearch-filenames t))
b4b6bda2
JL
2545 (isearch-forward)))
2546
2547;;;###autoload
2548(defun dired-isearch-filenames-regexp ()
2549 "Search for a regexp using Isearch only in file names in the Dired buffer."
2550 (interactive)
b9d9c159 2551 (let ((dired-isearch-filenames t))
b4b6bda2
JL
2552 (isearch-forward-regexp)))
2553
2554\f
2297e912
RM
2555;; Functions for searching in tags style among marked files.
2556
160c8be6
JL
2557;;;###autoload
2558(defun dired-do-isearch ()
2559 "Search for a string through all marked files using Isearch."
2560 (interactive)
2561 (multi-isearch-files
2562 (dired-get-marked-files nil nil 'dired-nondirectory-p)))
2563
2564;;;###autoload
2565(defun dired-do-isearch-regexp ()
2566 "Search for a regexp through all marked files using Isearch."
2567 (interactive)
2568 (multi-isearch-files-regexp
2569 (dired-get-marked-files nil nil 'dired-nondirectory-p)))
2570
2297e912 2571;;;###autoload
5c0b696b 2572(defun dired-do-search (regexp)
2297e912
RM
2573 "Search through all marked files for a match for REGEXP.
2574Stops when a match is found.
2575To continue searching for next match, use command \\[tags-loop-continue]."
2576 (interactive "sSearch marked files (regexp): ")
5e514c27 2577 (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2297e912
RM
2578
2579;;;###autoload
be3981a8 2580(defun dired-do-query-replace-regexp (from to &optional delimited)
5c0b696b 2581 "Do `query-replace-regexp' of FROM with TO, on all marked files.
2297e912 2582Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
e5374284 2583If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
2297e912
RM
2584with the command \\[tags-loop-continue]."
2585 (interactive
0751a704
JL
2586 (let ((common
2587 (query-replace-read-args
2588 "Query replace regexp in marked files" t t)))
2589 (list (nth 0 common) (nth 1 common) (nth 2 common))))
d1c553c8
RS
2590 (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
2591 (let ((buffer (get-file-buffer file)))
2592 (if (and buffer (with-current-buffer buffer
2593 buffer-read-only))
60a8f928 2594 (error "File `%s' is visited read-only" file))))
5e514c27
RS
2595 (tags-query-replace from to delimited
2596 '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2597
2598(defun dired-nondirectory-p (file)
2599 (not (file-directory-p file)))
83fadedf 2600\f
ee6be958
MB
2601;;;###autoload
2602(defun dired-show-file-type (file &optional deref-symlinks)
2603 "Print the type of FILE, according to the `file' command.
26bde865
LMI
2604If you give a prefix to this command, and FILE is a symbolic
2605link, then the type of the file linked to by FILE is printed
2606instead."
ee6be958 2607 (interactive (list (dired-get-filename t) current-prefix-arg))
b967bd19
MA
2608 (let (process-file-side-effects)
2609 (with-temp-buffer
2610 (if deref-symlinks
2611 (process-file "file" nil t t "-L" "--" file)
2612 (process-file "file" nil t t "--" file))
2613 (when (bolp)
2614 (backward-delete-char 1))
2615 (message "%s" (buffer-string)))))
2297e912 2616
80ec9ac5
RS
2617(provide 'dired-aux)
2618
276f1d00
GM
2619;; Local Variables:
2620;; byte-compile-dynamic: t
2621;; generated-autoload-file: "dired.el"
2622;; End:
2623
e5167999 2624;;; dired-aux.el ends here