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