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