Line data Source code
1 : ;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1985-1986, 1992-1997, 2000-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
7 : ;; Maintainer: emacs-devel@gnu.org
8 : ;; Keywords: files
9 : ;; Package: emacs
10 :
11 : ;; This file is part of GNU Emacs.
12 :
13 : ;; GNU Emacs is free software: you can redistribute it and/or modify
14 : ;; it under the terms of the GNU General Public License as published by
15 : ;; the Free Software Foundation, either version 3 of the License, or
16 : ;; (at your option) any later version.
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
24 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 :
26 : ;;; Commentary:
27 :
28 : ;; This is a major mode for directory browsing and editing.
29 : ;; It is documented in the Emacs manual.
30 :
31 : ;; Rewritten in 1990/1991 to add tree features, file marking and
32 : ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
33 : ;; Finished up by rms in 1992.
34 :
35 : ;;; Code:
36 :
37 : (eval-when-compile (require 'subr-x))
38 : ;; When bootstrapping dired-loaddefs has not been generated.
39 : (require 'dired-loaddefs nil t)
40 :
41 : (declare-function dired-buffer-more-recently-used-p
42 : "dired-x" (buffer1 buffer2))
43 :
44 : ;;; Customizable variables
45 :
46 : (defgroup dired nil
47 : "Directory editing."
48 : :link '(custom-manual "(emacs)Dired")
49 : :group 'files)
50 :
51 : (defgroup dired-mark nil
52 : "Handling marks in Dired."
53 : :prefix "dired-"
54 : :group 'dired)
55 :
56 :
57 : ;;;###autoload
58 : (defcustom dired-listing-switches (purecopy "-al")
59 : "Switches passed to `ls' for Dired. MUST contain the `l' option.
60 : May contain all other options that don't contradict `-l';
61 : may contain even `F', `b', `i' and `s'. See also the variable
62 : `dired-ls-F-marks-symlinks' concerning the `F' switch.
63 : Options that include embedded whitespace must be quoted
64 : like this: \\\"--option=value with spaces\\\"; you can use
65 : `combine-and-quote-strings' to produce the correct quoting of
66 : each option.
67 : On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
68 : some of the `ls' switches are not supported; see the doc string of
69 : `insert-directory' in `ls-lisp.el' for more details."
70 : :type 'string
71 : :group 'dired)
72 :
73 : (defcustom dired-subdir-switches nil
74 : "If non-nil, switches passed to `ls' for inserting subdirectories.
75 : If nil, `dired-listing-switches' is used."
76 : :group 'dired
77 : :type '(choice (const :tag "Use dired-listing-switches" nil)
78 : (string :tag "Switches")))
79 :
80 : (defcustom dired-chown-program
81 : (purecopy (cond ((executable-find "chown") "chown")
82 : ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
83 : ((file-executable-p "/etc/chown") "/etc/chown")
84 : (t "chown")))
85 : "Name of chown command (usually `chown')."
86 : :group 'dired
87 : :type 'file)
88 :
89 : (defcustom dired-use-ls-dired 'unspecified
90 : "Non-nil means Dired should pass the \"--dired\" option to \"ls\".
91 : The special value of `unspecified' means to check explicitly, and
92 : save the result in this variable. This is performed the first
93 : time `dired-insert-directory' is called.
94 :
95 : Note that if you set this option to nil, either through choice or
96 : because your \"ls\" program does not support \"--dired\", Dired
97 : will fail to parse some \"unusual\" file names, e.g. those with leading
98 : spaces. You might want to install ls from GNU Coreutils, which does
99 : support this option. Alternatively, you might want to use Emacs's
100 : own emulation of \"ls\", by using:
101 : (setq ls-lisp-use-insert-directory-program nil)
102 : (require \\='ls-lisp)
103 : This is used by default on MS Windows, which does not have an \"ls\" program.
104 : Note that `ls-lisp' does not support as many options as GNU ls, though.
105 : For more details, see Info node `(emacs)ls in Lisp'."
106 : :group 'dired
107 : :type '(choice (const :tag "Check for --dired support" unspecified)
108 : (const :tag "Do not use --dired" nil)
109 : (other :tag "Use --dired" t)))
110 :
111 : (defcustom dired-chmod-program "chmod"
112 : "Name of chmod command (usually `chmod')."
113 : :group 'dired
114 : :type 'file)
115 :
116 : (defcustom dired-touch-program "touch"
117 : "Name of touch command (usually `touch')."
118 : :group 'dired
119 : :type 'file)
120 :
121 : (defcustom dired-ls-F-marks-symlinks nil
122 : "Informs Dired about how `ls -lF' marks symbolic links.
123 : Set this to t if `ls' (or whatever program is specified by
124 : `insert-directory-program') with `-lF' marks the symbolic link
125 : itself with a trailing @ (usually the case under Ultrix).
126 :
127 : Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
128 : nil (the default), if it gives `bar@ -> foo', set it to t.
129 :
130 : Dired checks if there is really a @ appended. Thus, if you have a
131 : marking `ls' program on one host and a non-marking on another host, and
132 : don't care about symbolic links which really end in a @, you can
133 : always set this variable to t."
134 : :type 'boolean
135 : :group 'dired-mark)
136 :
137 : (defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
138 : "Regexp of files to skip when finding first file of a directory.
139 : A value of nil means move to the subdir line.
140 : A value of t means move to first file."
141 : :type '(choice (const :tag "Move to subdir" nil)
142 : (const :tag "Move to first" t)
143 : regexp)
144 : :group 'dired)
145 :
146 : (defcustom dired-keep-marker-rename t
147 : ;; Use t as default so that moved files "take their markers with them".
148 : "Controls marking of renamed files.
149 : If t, files keep their previous marks when they are renamed.
150 : If a character, renamed files (whether previously marked or not)
151 : are afterward marked with that character.
152 : This option affects only files renamed by `dired-do-rename' and
153 : `dired-do-rename-regexp'. See `wdired-keep-marker-rename'
154 : if you want to do the same for files renamed in WDired mode."
155 : :type '(choice (const :tag "Keep" t)
156 : (character :tag "Mark" :value ?R))
157 : :group 'dired-mark)
158 :
159 : (defcustom dired-keep-marker-copy ?C
160 : "Controls marking of copied files.
161 : If t, copied files are marked if and as the corresponding original files were.
162 : If a character, copied files are unconditionally marked with that character."
163 : :type '(choice (const :tag "Keep" t)
164 : (character :tag "Mark"))
165 : :group 'dired-mark)
166 :
167 : (defcustom dired-keep-marker-hardlink ?H
168 : "Controls marking of newly made hard links.
169 : If t, they are marked if and as the files linked to were marked.
170 : If a character, new links are unconditionally marked with that character."
171 : :type '(choice (const :tag "Keep" t)
172 : (character :tag "Mark"))
173 : :group 'dired-mark)
174 :
175 : (defcustom dired-keep-marker-symlink ?Y
176 : "Controls marking of newly made symbolic links.
177 : If t, they are marked if and as the files linked to were marked.
178 : If a character, new links are unconditionally marked with that character."
179 : :type '(choice (const :tag "Keep" t)
180 : (character :tag "Mark"))
181 : :group 'dired-mark)
182 :
183 : (defcustom dired-dwim-target nil
184 : "If non-nil, Dired tries to guess a default target directory.
185 : This means: if there is a Dired buffer displayed in the next
186 : window, use its current directory, instead of this Dired buffer's
187 : current directory.
188 :
189 : The target is used in the prompt for file copy, rename etc."
190 : :type 'boolean
191 : :group 'dired)
192 :
193 : (defcustom dired-copy-preserve-time t
194 : "If non-nil, Dired preserves the last-modified time in a file copy.
195 : \(This works on only some systems.)"
196 : :type 'boolean
197 : :group 'dired)
198 :
199 : ; These variables were deleted and the replacements are on files.el.
200 : ; We leave aliases behind for back-compatibility.
201 : (defvaralias 'dired-free-space-program 'directory-free-space-program)
202 : (defvaralias 'dired-free-space-args 'directory-free-space-args)
203 :
204 : ;;; Hook variables
205 :
206 : (defcustom dired-load-hook nil
207 : "Run after loading Dired.
208 : You can customize key bindings or load extensions with this."
209 : :group 'dired
210 : :type 'hook)
211 :
212 : (defcustom dired-mode-hook nil
213 : "Run at the very end of `dired-mode'."
214 : :group 'dired
215 : :type 'hook)
216 :
217 : (defcustom dired-before-readin-hook nil
218 : "This hook is run before a Dired buffer is read in (created or reverted)."
219 : :group 'dired
220 : :type 'hook)
221 :
222 : (defcustom dired-after-readin-hook nil
223 : "Hook run after each time a file or directory is read by Dired.
224 : After each listing of a file or directory, this hook is run
225 : with the buffer narrowed to the listing."
226 : :group 'dired
227 : :type 'hook)
228 : ;; Note this can't simply be run inside function `dired-ls' as the hook
229 : ;; functions probably depend on the dired-subdir-alist to be OK.
230 :
231 : (defcustom dired-initial-position-hook nil
232 : "This hook is used to position the point.
233 : It is run by the function `dired-initial-position'."
234 : :group 'dired
235 : :type 'hook
236 : :version "24.4")
237 :
238 : (defcustom dired-dnd-protocol-alist
239 : '(("^file:///" . dired-dnd-handle-local-file)
240 : ("^file://" . dired-dnd-handle-file)
241 : ("^file:" . dired-dnd-handle-local-file))
242 : "The functions to call when a drop in `dired-mode' is made.
243 : See `dnd-protocol-alist' for more information. When nil, behave
244 : as in other buffers. Changing this option is effective only for
245 : new Dired buffers."
246 : :type '(choice (repeat (cons (regexp) (function)))
247 : (const :tag "Behave as in other buffers" nil))
248 : :version "22.1"
249 : :group 'dired)
250 :
251 : (defcustom dired-hide-details-hide-symlink-targets t
252 : "Non-nil means `dired-hide-details-mode' hides symbolic link targets."
253 : :type 'boolean
254 : :version "24.4"
255 : :group 'dired)
256 :
257 : (defcustom dired-hide-details-hide-information-lines t
258 : "Non-nil means `dired-hide-details-mode' hides all but header and file lines."
259 : :type 'boolean
260 : :version "24.4"
261 : :group 'dired)
262 :
263 : (defcustom dired-always-read-filesystem nil
264 : "Non-nil means revert buffers visiting files before searching them.
265 : By default, commands like `dired-mark-files-containing-regexp' will
266 : search any buffers visiting the marked files without reverting them,
267 : even if they were changed on disk. When this option is non-nil, such
268 : buffers are always reverted in a temporary buffer before searching
269 : them: the search is performed on the temporary buffer, the original
270 : buffer visiting the file is not modified."
271 : :type 'boolean
272 : :version "26.1"
273 : :group 'dired)
274 :
275 : ;; Internal variables
276 :
277 : (defvar dired-marker-char ?* ; the answer is 42
278 : ;; so that you can write things like
279 : ;; (let ((dired-marker-char ?X))
280 : ;; ;; great code using X markers ...
281 : ;; )
282 : ;; For example, commands operating on two sets of files, A and B.
283 : ;; Or marking files with digits 0-9. This could implicate
284 : ;; concentric sets or an order for the marked files.
285 : ;; The code depends on dynamic scoping on the marker char.
286 : "In Dired, the current mark character.
287 : This is what the do-commands look for, and what the mark-commands store.")
288 :
289 : (defvar dired-del-marker ?D
290 : "Character used to flag files for deletion.")
291 :
292 : (defvar dired-shrink-to-fit t
293 : ;; I see no reason ever to make this nil -- rms.
294 : ;; (> baud-rate search-slow-speed)
295 : "Non-nil means Dired shrinks the display buffer to fit the marked files.")
296 : (make-obsolete-variable 'dired-shrink-to-fit
297 : "use the Customization interface to add a new rule
298 : to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
299 : action argument symbol is `window-height' and its value is nil." "24.3")
300 :
301 : (defvar dired-file-version-alist)
302 :
303 : ;;;###autoload
304 : (defvar dired-directory nil
305 : "The directory name or wildcard spec that this Dired directory lists.
306 : Local to each Dired buffer. May be a list, in which case the car is the
307 : directory name and the cdr is the list of files to mention.
308 : The directory name must be absolute, but need not be fully expanded.")
309 :
310 : ;; Beware of "-l;reboot" etc. See bug#3230.
311 : (defun dired-safe-switches-p (switches)
312 : "Return non-nil if string SWITCHES does not look risky for Dired."
313 0 : (or (not switches)
314 0 : (and (stringp switches)
315 0 : (< (length switches) 100) ; arbitrary
316 0 : (string-match-p "\\` *-[- [:alnum:]]+\\'" switches))))
317 :
318 : (defvar dired-actual-switches nil
319 : "The value of `dired-listing-switches' used to make this buffer's text.")
320 :
321 : (put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p)
322 :
323 : (defvar dired-re-inode-size "[0-9 \t]*[.,0-9]*[BkKMGTPEZY]?[ \t]*"
324 : "Regexp for optional initial inode and file size as made by `ls -i -s'.")
325 :
326 : ;; These regexps must be tested at beginning-of-line, but are also
327 : ;; used to search for next matches, so neither omitting "^" nor
328 : ;; replacing "^" by "\n" (to make it slightly faster) will work.
329 :
330 : (defvar dired-re-mark "^[^ \n]")
331 : ;; "Regexp matching a marked line.
332 : ;; Important: the match ends just after the marker."
333 : (defvar dired-re-maybe-mark "^. ")
334 : ;; The [^:] part after "d" and "l" is to avoid confusion with the
335 : ;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
336 : (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
337 : (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
338 : (defvar dired-re-exe;; match ls permission string of an executable file
339 : (mapconcat (lambda (x)
340 : (concat dired-re-maybe-mark dired-re-inode-size x))
341 : '("-[-r][-w][xs][-r][-w].[-r][-w]."
342 : "-[-r][-w].[-r][-w][xs][-r][-w]."
343 : "-[-r][-w].[-r][-w].[-r][-w][xst]")
344 : "\\|"))
345 : (defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
346 : (defvar dired-re-dot "^.* \\.\\.?/?$")
347 :
348 : ;; The subdirectory names in the next two lists are expanded.
349 : (defvar dired-subdir-alist nil
350 : "Association list of subdirectories and their buffer positions.
351 : Each subdirectory has an element: (DIRNAME . STARTMARKER).
352 : The order of elements is the reverse of the order in the buffer.
353 : In simple cases, this list contains one element.")
354 :
355 : (defvar-local dired-switches-alist nil
356 : "Keeps track of which switches to use for inserted subdirectories.
357 : This is an alist of the form (SUBDIR . SWITCHES).")
358 :
359 : (defvaralias 'dired-move-to-filename-regexp
360 : 'directory-listing-before-filename-regexp)
361 :
362 : (defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
363 : "Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
364 : Subexpression 1 is the subdirectory proper, no trailing colon.
365 : The match starts at the beginning of the line and ends after the end
366 : of the line (\\n or \\r).
367 : Subexpression 2 must end right before the \\n or \\r.")
368 :
369 : (defgroup dired-faces nil
370 : "Faces used by Dired."
371 : :group 'dired
372 : :group 'faces)
373 :
374 : (defface dired-header
375 : '((t (:inherit font-lock-type-face)))
376 : "Face used for directory headers."
377 : :group 'dired-faces
378 : :version "22.1")
379 : (defvar dired-header-face 'dired-header
380 : "Face name used for directory headers.")
381 :
382 : (defface dired-mark
383 : '((t (:inherit font-lock-constant-face)))
384 : "Face used for Dired marks."
385 : :group 'dired-faces
386 : :version "22.1")
387 : (defvar dired-mark-face 'dired-mark
388 : "Face name used for Dired marks.")
389 :
390 : (defface dired-marked
391 : '((t (:inherit warning)))
392 : "Face used for marked files."
393 : :group 'dired-faces
394 : :version "22.1")
395 : (defvar dired-marked-face 'dired-marked
396 : "Face name used for marked files.")
397 :
398 : (defface dired-flagged
399 : '((t (:inherit error)))
400 : "Face used for files flagged for deletion."
401 : :group 'dired-faces
402 : :version "22.1")
403 : (defvar dired-flagged-face 'dired-flagged
404 : "Face name used for files flagged for deletion.")
405 :
406 : (defface dired-warning
407 : ;; Inherit from font-lock-warning-face since with min-colors 8
408 : ;; font-lock-comment-face is not colored any more.
409 : '((t (:inherit font-lock-warning-face)))
410 : "Face used to highlight a part of a buffer that needs user attention."
411 : :group 'dired-faces
412 : :version "22.1")
413 : (defvar dired-warning-face 'dired-warning
414 : "Face name used for a part of a buffer that needs user attention.")
415 :
416 : (defface dired-perm-write
417 : '((((type w32 pc)) :inherit default) ;; These default to rw-rw-rw.
418 : ;; Inherit from font-lock-comment-delimiter-face since with min-colors 8
419 : ;; font-lock-comment-face is not colored any more.
420 : (t (:inherit font-lock-comment-delimiter-face)))
421 : "Face used to highlight permissions of group- and world-writable files."
422 : :group 'dired-faces
423 : :version "22.2")
424 : (defvar dired-perm-write-face 'dired-perm-write
425 : "Face name used for permissions of group- and world-writable files.")
426 :
427 : (defface dired-directory
428 : '((t (:inherit font-lock-function-name-face)))
429 : "Face used for subdirectories."
430 : :group 'dired-faces
431 : :version "22.1")
432 : (defvar dired-directory-face 'dired-directory
433 : "Face name used for subdirectories.")
434 :
435 : (defface dired-symlink
436 : '((t (:inherit font-lock-keyword-face)))
437 : "Face used for symbolic links."
438 : :group 'dired-faces
439 : :version "22.1")
440 : (defvar dired-symlink-face 'dired-symlink
441 : "Face name used for symbolic links.")
442 :
443 : (defface dired-ignored
444 : '((t (:inherit shadow)))
445 : "Face used for files suffixed with `completion-ignored-extensions'."
446 : :group 'dired-faces
447 : :version "22.1")
448 : (defvar dired-ignored-face 'dired-ignored
449 : "Face name used for files suffixed with `completion-ignored-extensions'.")
450 :
451 : (defvar dired-font-lock-keywords
452 : (list
453 : ;;
454 : ;; Dired marks.
455 : (list dired-re-mark '(0 dired-mark-face))
456 : ;;
457 : ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
458 : ;; file name itself. We search for Dired defined regexps, and then use the
459 : ;; Dired defined function `dired-move-to-filename' before searching for the
460 : ;; simple regexp ".+". It is that regexp which matches the file name.
461 : ;;
462 : ;; Marked files.
463 : (list (concat "^[" (char-to-string dired-marker-char) "]")
464 : '(".+" (dired-move-to-filename) nil (0 dired-marked-face)))
465 : ;;
466 : ;; Flagged files.
467 : (list (concat "^[" (char-to-string dired-del-marker) "]")
468 : '(".+" (dired-move-to-filename) nil (0 dired-flagged-face)))
469 : ;; People who are paranoid about security would consider this more
470 : ;; important than other things such as whether it is a directory.
471 : ;; But we don't want to encourage paranoia, so our default
472 : ;; should be what's most useful for non-paranoids. -- rms.
473 : ;;; ;;
474 : ;;; ;; Files that are group or world writable.
475 : ;;; (list (concat dired-re-maybe-mark dired-re-inode-size
476 : ;;; "\\([-d]\\(....w....\\|.......w.\\)\\)")
477 : ;;; '(1 dired-warning-face)
478 : ;;; '(".+" (dired-move-to-filename) nil (0 dired-warning-face)))
479 : ;; However, we don't need to highlight the file name, only the
480 : ;; permissions, to win generally. -- fx.
481 : ;; Fixme: we could also put text properties on the permission
482 : ;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
483 : (list (concat dired-re-maybe-mark dired-re-inode-size
484 : "[-d]....\\(w\\)....") ; group writable
485 : '(1 dired-perm-write-face))
486 : (list (concat dired-re-maybe-mark dired-re-inode-size
487 : "[-d].......\\(w\\).") ; world writable
488 : '(1 dired-perm-write-face))
489 : ;;
490 : ;; Subdirectories.
491 : (list dired-re-dir
492 : '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
493 : ;;
494 : ;; Symbolic links.
495 : (list dired-re-sym
496 : '(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
497 : ;;
498 : ;; Files suffixed with `completion-ignored-extensions'.
499 : '(eval .
500 : ;; It is quicker to first find just an extension, then go back to the
501 : ;; start of that file name. So we do this complex MATCH-ANCHORED form.
502 : (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
503 : '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
504 : ;;
505 : ;; Files suffixed with `completion-ignored-extensions'
506 : ;; plus a character put in by -F.
507 : '(eval .
508 : (list (concat "\\(" (regexp-opt completion-ignored-extensions)
509 : "\\|#\\)[*=|]$")
510 : '(".+" (progn
511 : (end-of-line)
512 : ;; If the last character is not part of the filename,
513 : ;; move back to the start of the filename
514 : ;; so it can be fontified.
515 : ;; Otherwise, leave point at the end of the line;
516 : ;; that way, nothing is fontified.
517 : (unless (get-text-property (1- (point)) 'mouse-face)
518 : (dired-move-to-filename)))
519 : nil (0 dired-ignored-face))))
520 : ;;
521 : ;; Explicitly put the default face on file names ending in a colon to
522 : ;; avoid fontifying them as directory header.
523 : (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
524 : '(".+" (dired-move-to-filename) nil (0 'default)))
525 : ;;
526 : ;; Directory headers.
527 : (list dired-subdir-regexp '(1 dired-header-face))
528 : )
529 : "Additional expressions to highlight in Dired mode.")
530 :
531 : (defvar dnd-protocol-alist)
532 :
533 : ;;; Macros must be defined before they are used, for the byte compiler.
534 :
535 : (defmacro dired-mark-if (predicate msg)
536 : "Mark all files for which PREDICATE evals to non-nil.
537 : PREDICATE is evaluated on each line, with point at beginning of line.
538 : MSG is a noun phrase for the type of files being marked.
539 : It should end with a noun that can be pluralized by adding `s'.
540 : Return value is the number of files marked, or nil if none were marked."
541 7 : `(let ((inhibit-read-only t) count)
542 : (save-excursion
543 : (setq count 0)
544 7 : (when ,msg
545 : (message "%s %ss%s..."
546 : (cond ((eq dired-marker-char ?\040) "Unmarking")
547 : ((eq dired-del-marker dired-marker-char)
548 : "Flagging")
549 : (t "Marking"))
550 7 : ,msg
551 : (if (eq dired-del-marker dired-marker-char)
552 : " for deletion"
553 : "")))
554 : (goto-char (point-min))
555 : (while (not (eobp))
556 7 : (if ,predicate
557 : (progn
558 : (delete-char 1)
559 : (insert dired-marker-char)
560 : (setq count (1+ count))))
561 : (forward-line 1))
562 7 : (if ,msg (message "%s %s%s %s%s."
563 : count
564 7 : ,msg
565 : (dired-plural-s count)
566 : (if (eq dired-marker-char ?\040) "un" "")
567 : (if (eq dired-marker-char dired-del-marker)
568 : "flagged" "marked"))))
569 7 : (and (> count 0) count)))
570 :
571 : (defmacro dired-map-over-marks (body arg &optional show-progress
572 : distinguish-one-marked)
573 : "Eval BODY with point on each marked line. Return a list of BODY's results.
574 : If no marked file could be found, execute BODY on the current
575 : line. ARG, if non-nil, specifies the files to use instead of the
576 : marked files.
577 :
578 : If ARG is an integer, use the next ARG (or previous -ARG, if
579 : ARG<0) files. In that case, point is dragged along. This is so
580 : that commands on the next ARG (instead of the marked) files can
581 : be chained easily.
582 : For any other non-nil value of ARG, use the current file.
583 :
584 : If optional third arg SHOW-PROGRESS evaluates to non-nil,
585 : redisplay the dired buffer after each file is processed.
586 :
587 : No guarantee is made about the position on the marked line.
588 : BODY must ensure this itself if it depends on this.
589 :
590 : Search starts at the beginning of the buffer, thus the car of the
591 : list corresponds to the line nearest to the buffer's bottom.
592 : This is also true for (positive and negative) integer values of
593 : ARG.
594 :
595 : BODY should not be too long as it is expanded four times.
596 :
597 : If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one
598 : marked file, return (t FILENAME) instead of (FILENAME)."
599 : ;;
600 : ;;Warning: BODY must not add new lines before point - this may cause an
601 : ;;endless loop.
602 : ;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
603 3 : `(prog1
604 : (let ((inhibit-read-only t) case-fold-search found results)
605 3 : (if ,arg
606 3 : (if (integerp ,arg)
607 : (progn ;; no save-excursion, want to move point.
608 : (dired-repeat-over-lines
609 3 : ,arg
610 : (lambda ()
611 3 : (if ,show-progress (sit-for 0))
612 3 : (setq results (cons ,body results))))
613 3 : (if (< ,arg 0)
614 : (nreverse results)
615 : results))
616 : ;; non-nil, non-integer ARG means use current file:
617 3 : (list ,body))
618 : (let ((regexp (dired-marker-regexp)) next-position)
619 : (save-excursion
620 : (goto-char (point-min))
621 : ;; remember position of next marked file before BODY
622 : ;; can insert lines before the just found file,
623 : ;; confusing us by finding the same marked file again
624 : ;; and again and...
625 : (setq next-position (and (re-search-forward regexp nil t)
626 : (point-marker))
627 : found (not (null next-position)))
628 : (while next-position
629 : (goto-char next-position)
630 3 : (if ,show-progress (sit-for 0))
631 3 : (setq results (cons ,body results))
632 : ;; move after last match
633 : (goto-char next-position)
634 : (forward-line 1)
635 : (set-marker next-position nil)
636 : (setq next-position (and (re-search-forward regexp nil t)
637 : (point-marker)))))
638 3 : (if (and ,distinguish-one-marked (= (length results) 1))
639 : (setq results (cons t results)))
640 : (if found
641 : results
642 3 : (list ,body)))))
643 : ;; save-excursion loses, again
644 3 : (dired-move-to-filename)))
645 :
646 : (defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
647 : "Return the marked files' names as list of strings.
648 : The list is in the same order as the buffer, that is, the car is the
649 : first marked file.
650 : Values returned are normally absolute file names.
651 : Optional arg LOCALP as in `dired-get-filename'.
652 : Optional second argument ARG, if non-nil, specifies files near
653 : point instead of marked files. It usually comes from the prefix
654 : argument.
655 : If ARG is an integer, use the next ARG files.
656 : If ARG is any other non-nil value, return the current file name.
657 : If no files are marked, and ARG is nil, also return the current file name.
658 : Optional third argument FILTER, if non-nil, is a function to select
659 : some of the files--those for which (funcall FILTER FILENAME) is non-nil.
660 :
661 : If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
662 : return (t FILENAME) instead of (FILENAME).
663 : Don't use that together with FILTER."
664 0 : (let ((all-of-them
665 0 : (save-excursion
666 0 : (delq nil (dired-map-over-marks
667 : (dired-get-filename localp 'no-error-if-not-filep)
668 0 : arg nil distinguish-one-marked))))
669 : result)
670 0 : (when (equal all-of-them '(t))
671 0 : (setq all-of-them nil))
672 0 : (if (not filter)
673 0 : (if (and distinguish-one-marked (eq (car all-of-them) t))
674 0 : all-of-them
675 0 : (nreverse all-of-them))
676 0 : (dolist (file all-of-them)
677 0 : (if (funcall filter file)
678 0 : (push file result)))
679 0 : result)))
680 :
681 : ;; The dired command
682 :
683 : (defun dired-read-dir-and-switches (str)
684 : ;; For use in interactive.
685 0 : (reverse (list
686 0 : (if current-prefix-arg
687 0 : (read-string "Dired listing switches: "
688 0 : dired-listing-switches))
689 : ;; If a dialog is used, call `read-directory-name' so the
690 : ;; dialog code knows we want directories. Some dialogs
691 : ;; can only select directories or files when popped up,
692 : ;; not both. If no dialog is used, call `read-file-name'
693 : ;; because the user may want completion of file names for
694 : ;; use in a wildcard pattern.
695 0 : (if (next-read-file-uses-dialog-p)
696 0 : (read-directory-name (format "Dired %s(directory): " str)
697 0 : nil default-directory nil)
698 0 : (read-file-name (format "Dired %s(directory): " str)
699 0 : nil default-directory nil)))))
700 :
701 : ;; We want to switch to a more sophisticated version of
702 : ;; dired-read-dir-and-switches like the following, if there is a way
703 : ;; to make it more intuitive. See bug#1285.
704 :
705 : ;; (defun dired-read-dir-and-switches (str)
706 : ;; ;; For use in interactive.
707 : ;; (reverse
708 : ;; (list
709 : ;; (if current-prefix-arg
710 : ;; (read-string "Dired listing switches: "
711 : ;; dired-listing-switches))
712 : ;; ;; If a dialog is about to be used, call read-directory-name so
713 : ;; ;; the dialog code knows we want directories. Some dialogs can
714 : ;; ;; only select directories or files when popped up, not both.
715 : ;; (if (next-read-file-uses-dialog-p)
716 : ;; (read-directory-name (format "Dired %s(directory): " str)
717 : ;; nil default-directory nil)
718 : ;; (let ((cie ()))
719 : ;; (dolist (ext completion-ignored-extensions)
720 : ;; (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
721 : ;; (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
722 : ;; (let* ((default (and buffer-file-name
723 : ;; (abbreviate-file-name buffer-file-name)))
724 : ;; (cie cie)
725 : ;; (completion-table
726 : ;; ;; We need a mix of read-file-name and
727 : ;; ;; read-directory-name so that completion to directories
728 : ;; ;; is preferred, but if the user wants to enter a global
729 : ;; ;; pattern, he can still use completion on filenames to
730 : ;; ;; help him write the pattern.
731 : ;; ;; Essentially, we want to use
732 : ;; ;; (completion-table-with-predicate
733 : ;; ;; 'read-file-name-internal 'file-directory-p nil)
734 : ;; ;; but that doesn't work because read-file-name-internal
735 : ;; ;; does not obey its `predicate' argument.
736 : ;; (completion-table-in-turn
737 : ;; (lambda (str pred action)
738 : ;; (let ((read-file-name-predicate
739 : ;; (lambda (f)
740 : ;; (and (not (member f '("./" "../")))
741 : ;; ;; Hack! Faster than file-directory-p!
742 : ;; (eq (aref f (1- (length f))) ?/)
743 : ;; (not (string-match cie f))))))
744 : ;; (complete-with-action
745 : ;; action 'read-file-name-internal str nil)))
746 : ;; 'read-file-name-internal)))
747 : ;; (minibuffer-with-setup-hook
748 : ;; (lambda ()
749 : ;; (setq minibuffer-default default)
750 : ;; (setq minibuffer-completion-table completion-table))
751 : ;; (read-file-name (format "Dired %s(directory): " str)
752 : ;; nil default-directory nil))))))))
753 :
754 : (defun dired-file-name-at-point ()
755 : "Try to get a file name at point in the current dired buffer.
756 : This hook is intended to be put in `file-name-at-point-functions'.
757 : Note that it returns an abbreviated name that can't be used
758 : as an argument to `dired-goto-file'."
759 0 : (let ((filename (dired-get-filename nil t)))
760 0 : (when filename
761 0 : (if (file-directory-p filename)
762 0 : (file-name-as-directory (abbreviate-file-name filename))
763 0 : (abbreviate-file-name filename)))))
764 :
765 : ;;;###autoload (define-key ctl-x-map "d" 'dired)
766 : ;;;###autoload
767 : (defun dired (dirname &optional switches)
768 : "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
769 : Optional second argument SWITCHES specifies the `ls' options used.
770 : \(Interactively, use a prefix argument to be able to specify SWITCHES.)
771 :
772 : If DIRNAME is a string, Dired displays a list of files in DIRNAME (which
773 : may also have shell wildcards appended to select certain files).
774 :
775 : If DIRNAME is a cons, its first element is taken as the directory name
776 : and the rest as an explicit list of files to make directory entries for.
777 : In this case, SWITCHES are applied to each of the files separately, and
778 : therefore switches that control the order of the files in the produced
779 : listing have no effect.
780 :
781 : \\<dired-mode-map>\
782 : You can flag files for deletion with \\[dired-flag-file-deletion] and then
783 : delete them by typing \\[dired-do-flagged-delete].
784 : Type \\[describe-mode] after entering Dired for more info.
785 :
786 : If DIRNAME is already in a Dired buffer, that buffer is used without refresh."
787 : ;; Cannot use (interactive "D") because of wildcards.
788 0 : (interactive (dired-read-dir-and-switches ""))
789 0 : (pop-to-buffer-same-window (dired-noselect dirname switches)))
790 :
791 : ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
792 : ;;;###autoload
793 : (defun dired-other-window (dirname &optional switches)
794 : "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
795 0 : (interactive (dired-read-dir-and-switches "in other window "))
796 0 : (switch-to-buffer-other-window (dired-noselect dirname switches)))
797 :
798 : ;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
799 : ;;;###autoload
800 : (defun dired-other-frame (dirname &optional switches)
801 : "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
802 0 : (interactive (dired-read-dir-and-switches "in other frame "))
803 0 : (switch-to-buffer-other-frame (dired-noselect dirname switches)))
804 :
805 : ;;;###autoload
806 : (defun dired-noselect (dir-or-list &optional switches)
807 : "Like `dired' but returns the Dired buffer as value, does not select it."
808 6 : (or dir-or-list (setq dir-or-list default-directory))
809 : ;; This loses the distinction between "/foo/*/" and "/foo/*" that
810 : ;; some shells make:
811 6 : (let (dirname initially-was-dirname)
812 6 : (if (consp dir-or-list)
813 0 : (setq dirname (car dir-or-list))
814 6 : (setq dirname dir-or-list))
815 6 : (setq initially-was-dirname
816 6 : (string= (file-name-as-directory dirname) dirname))
817 6 : (setq dirname (abbreviate-file-name
818 6 : (expand-file-name (directory-file-name dirname))))
819 6 : (if find-file-visit-truename
820 6 : (setq dirname (file-truename dirname)))
821 : ;; If the argument was syntactically a directory name not a file name,
822 : ;; or if it happens to name a file that is a directory,
823 : ;; convert it syntactically to a directory name.
824 : ;; The reason for checking initially-was-dirname
825 : ;; and not just file-directory-p
826 : ;; is that file-directory-p is slow over ftp.
827 6 : (if (or initially-was-dirname (file-directory-p dirname))
828 6 : (setq dirname (file-name-as-directory dirname)))
829 6 : (if (consp dir-or-list)
830 0 : (setq dir-or-list (cons dirname (cdr dir-or-list)))
831 6 : (setq dir-or-list dirname))
832 6 : (dired-internal-noselect dir-or-list switches)))
833 :
834 : ;; The following is an internal dired function. It returns non-nil if
835 : ;; the directory visited by the current dired buffer has changed on
836 : ;; disk. DIRNAME should be the directory name of that directory.
837 : (defun dired-directory-changed-p (dirname)
838 0 : (not (let ((attributes (file-attributes dirname))
839 0 : (modtime (visited-file-modtime)))
840 0 : (or (eq modtime 0)
841 0 : (not (eq (car attributes) t))
842 0 : (equal (nth 5 attributes) modtime)))))
843 :
844 : (defun dired-buffer-stale-p (&optional noconfirm)
845 : "Return non-nil if current Dired buffer needs updating.
846 : If NOCONFIRM is non-nil, then this function always returns nil
847 : for a remote directory. This feature is used by Auto Revert mode."
848 0 : (let ((dirname
849 0 : (if (consp dired-directory) (car dired-directory) dired-directory)))
850 0 : (and (stringp dirname)
851 0 : (not (when noconfirm (file-remote-p dirname)))
852 0 : (file-readable-p dirname)
853 : ;; Do not auto-revert when the dired buffer can be currently
854 : ;; written by the user as in `wdired-mode'.
855 0 : buffer-read-only
856 0 : (dired-directory-changed-p dirname))))
857 :
858 : (defcustom dired-auto-revert-buffer nil
859 : "Automatically revert Dired buffer on revisiting.
860 : If t, revisiting an existing Dired buffer automatically reverts it.
861 : If its value is a function, call this function with the directory
862 : name as single argument and revert the buffer if it returns non-nil.
863 : Otherwise, a message offering to revert the changed dired buffer
864 : is displayed.
865 : Note that this is not the same as `auto-revert-mode' that
866 : periodically reverts at specified time intervals."
867 : :type '(choice
868 : (const :tag "Don't revert" nil)
869 : (const :tag "Always revert visited Dired buffer" t)
870 : (const :tag "Revert changed Dired buffer" dired-directory-changed-p)
871 : (function :tag "Predicate function"))
872 : :group 'dired
873 : :version "23.2")
874 :
875 : (defun dired--need-align-p ()
876 : "Return non-nil if some file names are misaligned.
877 : The return value is the target column for the file names."
878 0 : (save-excursion
879 0 : (goto-char (point-min))
880 0 : (dired-goto-next-file)
881 : ;; Use point difference instead of `current-column', because
882 : ;; the former works when `dired-hide-details-mode' is enabled.
883 0 : (let* ((first (- (point) (point-at-bol)))
884 0 : (target first))
885 0 : (while (and (not (eobp))
886 0 : (progn
887 0 : (forward-line)
888 0 : (dired-move-to-filename)))
889 0 : (when-let* ((distance (- (point) (point-at-bol)))
890 0 : (higher (> distance target)))
891 0 : (setq target distance)))
892 0 : (and (/= first target) target))))
893 :
894 : (defun dired--align-all-files ()
895 : "Align all files adding spaces in front of the size column."
896 0 : (let ((target (dired--need-align-p))
897 0 : (regexp directory-listing-before-filename-regexp))
898 0 : (when target
899 0 : (save-excursion
900 0 : (goto-char (point-min))
901 0 : (dired-goto-next-file)
902 0 : (while (dired-move-to-filename)
903 : ;; Use point difference instead of `current-column', because
904 : ;; the former works when `dired-hide-details-mode' is enabled.
905 0 : (let ((distance (- target (- (point) (point-at-bol))))
906 : (inhibit-read-only t))
907 0 : (unless (zerop distance)
908 0 : (re-search-backward regexp nil t)
909 0 : (goto-char (match-beginning 0))
910 0 : (search-backward-regexp "[[:space:]]" nil t)
911 0 : (skip-chars-forward "[:space:]")
912 0 : (insert-char ?\s distance 'inherit))
913 0 : (forward-line)))))))
914 :
915 : (defun dired-internal-noselect (dir-or-list &optional switches mode)
916 : ;; If DIR-OR-LIST is a string and there is an existing dired buffer
917 : ;; for it, just leave buffer as it is (don't even call dired-revert).
918 : ;; This saves time especially for deep trees or with ange-ftp.
919 : ;; The user can type `g' easily, and it is more consistent with find-file.
920 : ;; But if SWITCHES are given they are probably different from the
921 : ;; buffer's old value, so call dired-sort-other, which does
922 : ;; revert the buffer.
923 : ;; Revert the buffer if DIR-OR-LIST is a cons or `dired-directory'
924 : ;; is a cons and DIR-OR-LIST is a string.
925 : ;; A pity we can't possibly do "Directory has changed - refresh? "
926 : ;; like find-file does.
927 : ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
928 : ;; see there.
929 6 : (let* ((old-buf (current-buffer))
930 6 : (dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
931 : ;; Look for an existing buffer.
932 6 : (buffer (dired-find-buffer-nocreate dirname mode))
933 : ;; Note that buffer already is in dired-mode, if found.
934 6 : (new-buffer-p (null buffer)))
935 6 : (or buffer
936 6 : (setq buffer (create-file-buffer (directory-file-name dirname))))
937 6 : (set-buffer buffer)
938 6 : (if (not new-buffer-p) ; existing buffer ...
939 0 : (cond (switches ; ... but new switches
940 : ;; file list may have changed
941 0 : (setq dired-directory dir-or-list)
942 : ;; this calls dired-revert
943 0 : (dired-sort-other switches))
944 : ;; Always revert when `dir-or-list' is a cons. Also revert
945 : ;; if `dired-directory' is a cons but `dir-or-list' is not.
946 0 : ((or (consp dir-or-list) (consp dired-directory))
947 0 : (setq dired-directory dir-or-list)
948 0 : (revert-buffer))
949 : ;; Always revert regardless of whether it has changed or not.
950 0 : ((eq dired-auto-revert-buffer t)
951 0 : (revert-buffer))
952 : ;; Revert when predicate function returns non-nil.
953 0 : ((functionp dired-auto-revert-buffer)
954 0 : (when (funcall dired-auto-revert-buffer dirname)
955 0 : (revert-buffer)
956 0 : (message "Changed directory automatically updated")))
957 : ;; If directory has changed on disk, offer to revert.
958 0 : ((when (dired-directory-changed-p dirname)
959 0 : (message "%s"
960 0 : (substitute-command-keys
961 0 : "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
962 : ;; Else a new buffer
963 6 : (setq default-directory
964 6 : (or (car-safe (insert-directory-wildcard-in-dir-p dirname))
965 : ;; We can do this unconditionally
966 : ;; because dired-noselect ensures that the name
967 : ;; is passed in directory name syntax
968 : ;; if it was the name of a directory at all.
969 6 : (file-name-directory dirname)))
970 6 : (or switches (setq switches dired-listing-switches))
971 6 : (if mode (funcall mode)
972 6 : (dired-mode dir-or-list switches))
973 : ;; default-directory and dired-actual-switches are set now
974 : ;; (buffer-local), so we can call dired-readin:
975 6 : (let ((failed t))
976 6 : (unwind-protect
977 6 : (progn (dired-readin)
978 6 : (setq failed nil))
979 : ;; dired-readin can fail if parent directories are inaccessible.
980 : ;; Don't leave an empty buffer around in that case.
981 6 : (if failed (kill-buffer buffer))))
982 6 : (goto-char (point-min))
983 6 : (dired-initial-position dirname))
984 6 : (when (consp dired-directory)
985 6 : (dired--align-all-files))
986 6 : (set-buffer old-buf)
987 6 : buffer))
988 :
989 : (defvar dired-buffers nil
990 : ;; Enlarged by dired-advertise
991 : ;; Queried by function dired-buffers-for-dir. When this detects a
992 : ;; killed buffer, it is removed from this list.
993 : "Alist of expanded directories and their associated Dired buffers.")
994 :
995 : (defvar dired-find-subdir)
996 :
997 : ;; FIXME add a doc-string, and document dired-x extensions.
998 : (defun dired-find-buffer-nocreate (dirname &optional mode)
999 : ;; This differs from dired-buffers-for-dir in that it does not consider
1000 : ;; subdirs of default-directory and searches for the first match only.
1001 : ;; Also, the major mode must be MODE.
1002 6 : (if (and (featurep 'dired-x)
1003 0 : dired-find-subdir
1004 : ;; Don't try to find a wildcard as a subdirectory.
1005 6 : (string-equal dirname (file-name-directory dirname)))
1006 0 : (let* ((cur-buf (current-buffer))
1007 0 : (buffers (nreverse
1008 0 : (dired-buffers-for-dir (expand-file-name dirname))))
1009 0 : (cur-buf-matches (and (memq cur-buf buffers)
1010 : ;; Wildcards must match, too:
1011 0 : (equal dired-directory dirname))))
1012 : ;; We don't want to switch to the same buffer---
1013 0 : (setq buffers (delq cur-buf buffers))
1014 0 : (or (car (sort buffers #'dired-buffer-more-recently-used-p))
1015 : ;; ---unless it's the only possibility:
1016 0 : (and cur-buf-matches cur-buf)))
1017 : ;; No dired-x, or dired-find-subdir nil.
1018 6 : (setq dirname (expand-file-name dirname))
1019 6 : (let (found (blist dired-buffers)) ; was (buffer-list)
1020 6 : (or mode (setq mode 'dired-mode))
1021 11 : (while blist
1022 5 : (if (null (buffer-name (cdr (car blist))))
1023 5 : (setq blist (cdr blist))
1024 0 : (with-current-buffer (cdr (car blist))
1025 0 : (if (and (eq major-mode mode)
1026 0 : dired-directory ;; nil during find-alternate-file
1027 0 : (equal dirname
1028 0 : (expand-file-name
1029 0 : (if (consp dired-directory)
1030 0 : (car dired-directory)
1031 0 : dired-directory))))
1032 0 : (setq found (cdr (car blist))
1033 0 : blist nil)
1034 6 : (setq blist (cdr blist))))))
1035 6 : found)))
1036 :
1037 :
1038 : ;; Read in a new dired buffer
1039 :
1040 : (defun dired-readin ()
1041 : "Read in a new Dired buffer.
1042 : Differs from `dired-insert-subdir' in that it accepts
1043 : wildcards, erases the buffer, and builds the subdir-alist anew
1044 : \(including making it buffer-local and clearing it first)."
1045 :
1046 : ;; default-directory and dired-actual-switches must be buffer-local
1047 : ;; and initialized by now.
1048 6 : (let (dirname
1049 : ;; This makes readin much much faster.
1050 : ;; In particular, it prevents the font lock hook from running
1051 : ;; until the directory is all read in.
1052 : (inhibit-modification-hooks t))
1053 6 : (if (consp dired-directory)
1054 0 : (setq dirname (car dired-directory))
1055 6 : (setq dirname dired-directory))
1056 6 : (setq dirname (expand-file-name dirname))
1057 6 : (save-excursion
1058 : ;; This hook which may want to modify dired-actual-switches
1059 : ;; based on dired-directory, e.g. with ange-ftp to a SysV host
1060 : ;; where ls won't understand -Al switches.
1061 6 : (run-hooks 'dired-before-readin-hook)
1062 6 : (if (consp buffer-undo-list)
1063 6 : (setq buffer-undo-list nil))
1064 6 : (setq-local file-name-coding-system
1065 6 : (or coding-system-for-read file-name-coding-system))
1066 6 : (let ((inhibit-read-only t)
1067 : ;; Don't make undo entries for readin.
1068 : (buffer-undo-list t))
1069 6 : (widen)
1070 6 : (erase-buffer)
1071 6 : (dired-readin-insert))
1072 6 : (goto-char (point-min))
1073 : ;; Must first make alist buffer local and set it to nil because
1074 : ;; dired-build-subdir-alist will call dired-clear-alist first
1075 6 : (setq-local dired-subdir-alist nil)
1076 6 : (dired-build-subdir-alist)
1077 6 : (let ((attributes (file-attributes dirname)))
1078 6 : (if (eq (car attributes) t)
1079 6 : (set-visited-file-modtime (nth 5 attributes))))
1080 6 : (set-buffer-modified-p nil)
1081 : ;; No need to narrow since the whole buffer contains just
1082 : ;; dired-readin's output, nothing else. The hook can
1083 : ;; successfully use dired functions (e.g. dired-get-filename)
1084 : ;; as the subdir-alist has been built in dired-readin.
1085 6 : (run-hooks 'dired-after-readin-hook))))
1086 :
1087 : ;; Subroutines of dired-readin
1088 :
1089 : (defun dired-readin-insert ()
1090 : ;; Insert listing for the specified dir (and maybe file list)
1091 : ;; already in dired-directory, assuming a clean buffer.
1092 6 : (let (dir file-list)
1093 6 : (if (consp dired-directory)
1094 0 : (setq dir (car dired-directory)
1095 0 : file-list (cdr dired-directory))
1096 6 : (setq dir dired-directory
1097 6 : file-list nil))
1098 6 : (setq dir (expand-file-name dir))
1099 6 : (if (and (equal "" (file-name-nondirectory dir))
1100 6 : (not file-list))
1101 : ;; If we are reading a whole single directory...
1102 0 : (dired-insert-directory dir dired-actual-switches nil nil t)
1103 6 : (if (and (not (insert-directory-wildcard-in-dir-p dir))
1104 2 : (not (file-readable-p
1105 6 : (directory-file-name (file-name-directory dir)))))
1106 6 : (error "Directory %s inaccessible or nonexistent" dir))
1107 : ;; Else treat it as a wildcard spec
1108 : ;; unless we have an explicit list of files.
1109 6 : (dired-insert-directory dir dired-actual-switches
1110 6 : file-list (not file-list) t))))
1111 :
1112 : (defun dired-align-file (beg end)
1113 : "Align the fields of a file to the ones of surrounding lines.
1114 : BEG..END is the line where the file info is located."
1115 : ;; Some versions of ls try to adjust the size of each field so as to just
1116 : ;; hold the largest element ("largest" in the current invocation, of
1117 : ;; course). So when a single line is output, the size of each field is
1118 : ;; just big enough for that one output. Thus when dired refreshes one
1119 : ;; line, the alignment if this line w.r.t the rest is messed up because
1120 : ;; the fields of that one line will generally be smaller.
1121 : ;;
1122 : ;; To work around this problem, we here add spaces to try and
1123 : ;; re-align the fields as needed. Since this is purely aesthetic,
1124 : ;; it is of utmost importance that it doesn't mess up anything like
1125 : ;; `dired-move-to-filename'. To this end, we limit ourselves to
1126 : ;; adding spaces only, and to only add them at places where there
1127 : ;; was already at least one space. This way, as long as
1128 : ;; `directory-listing-before-filename-regexp' always matches spaces
1129 : ;; with "*" or "+", we know we haven't made anything worse. There
1130 : ;; is one spot where the exact number of spaces is important, which
1131 : ;; is just before the actual filename, so we refrain from adding
1132 : ;; spaces there (and within the filename as well, of course).
1133 0 : (save-excursion
1134 0 : (let (file file-col other other-col)
1135 : ;; Check that there is indeed a file, and that there is another adjacent
1136 : ;; file with which to align, and that additional spaces are needed to
1137 : ;; align the filenames.
1138 0 : (when (and (setq file (progn (goto-char beg)
1139 0 : (dired-move-to-filename nil end)))
1140 0 : (setq file-col (current-column))
1141 0 : (setq other
1142 0 : (or (and (goto-char beg)
1143 0 : (zerop (forward-line -1))
1144 0 : (dired-move-to-filename))
1145 0 : (and (goto-char beg)
1146 0 : (zerop (forward-line 1))
1147 0 : (dired-move-to-filename))))
1148 0 : (setq other-col (current-column))
1149 0 : (/= file other)
1150 : ;; Make sure there is some work left to do.
1151 0 : (> other-col file-col))
1152 : ;; If we've only looked at the line above, check to see if the line
1153 : ;; below exists as well and if so, align with the shorter one.
1154 0 : (when (and (< other file)
1155 0 : (goto-char beg)
1156 0 : (zerop (forward-line 1))
1157 0 : (dired-move-to-filename))
1158 0 : (let ((alt-col (current-column)))
1159 0 : (when (< alt-col other-col)
1160 0 : (setq other-col alt-col)
1161 0 : (setq other (point)))))
1162 : ;; Keep positions uptodate when we insert stuff.
1163 0 : (if (> other file) (setq other (copy-marker other)))
1164 0 : (setq file (copy-marker file))
1165 : ;; Main loop.
1166 0 : (goto-char beg)
1167 0 : (skip-chars-forward " ") ;Skip to the first field.
1168 0 : (while (and (> other-col file-col)
1169 : ;; Don't touch anything just before (and after) the
1170 : ;; beginning of the filename.
1171 0 : (> file (point)))
1172 : ;; We're now just in front of a field, with a space behind us.
1173 0 : (let* ((curcol (current-column))
1174 : ;; Nums are right-aligned.
1175 0 : (num-align (looking-at-p "[0-9]"))
1176 : ;; Let's look at the other line, in the same column: we
1177 : ;; should be either near the end of the previous field, or
1178 : ;; in the space between that field and the next.
1179 : ;; [ Of course, it's also possible that we're already within
1180 : ;; the next field or even past it, but that's unlikely since
1181 : ;; other-col > file-col. ]
1182 : ;; Let's find the distance to the alignment-point (either
1183 : ;; the beginning or the end of the next field, depending on
1184 : ;; whether this field is left or right aligned).
1185 : (align-pt-offset
1186 0 : (save-excursion
1187 0 : (goto-char other)
1188 0 : (move-to-column curcol)
1189 0 : (when (looking-at
1190 0 : (concat
1191 0 : (if (eq (char-before) ?\s) " *" "[^ ]* *")
1192 0 : (if num-align "[0-9][^ ]*")))
1193 0 : (- (match-end 0) (match-beginning 0)))))
1194 : ;; Now, the number of spaces to insert is align-pt-offset
1195 : ;; minus the distance to the equivalent point on the
1196 : ;; current line.
1197 : (spaces
1198 0 : (if (not num-align)
1199 0 : align-pt-offset
1200 0 : (and align-pt-offset
1201 0 : (save-excursion
1202 0 : (skip-chars-forward "^ ")
1203 0 : (- align-pt-offset (- (current-column) curcol)))))))
1204 0 : (when (and spaces (> spaces 0))
1205 0 : (setq file-col (+ spaces file-col))
1206 0 : (if (> file-col other-col)
1207 0 : (setq spaces (- spaces (- file-col other-col))))
1208 0 : (insert-char ?\s spaces 'inherit)
1209 : ;; Let's just make really sure we did not mess up.
1210 0 : (unless (save-excursion
1211 0 : (eq (dired-move-to-filename) (marker-position file)))
1212 : ;; Damn! We messed up: let's revert the change.
1213 0 : (delete-char (- spaces)))))
1214 : ;; Now skip to next field.
1215 0 : (skip-chars-forward "^ ") (skip-chars-forward " "))
1216 0 : (set-marker file nil)))))
1217 :
1218 :
1219 : (defvar ls-lisp-use-insert-directory-program)
1220 :
1221 : (defun dired-check-switches (switches short &optional long)
1222 : "Return non-nil if the string SWITCHES matches LONG or SHORT format."
1223 230 : (let (case-fold-search)
1224 230 : (and (stringp switches)
1225 230 : (string-match-p (concat "\\(\\`\\| \\)-[[:alnum:]]*" short
1226 230 : (if long (concat "\\|--" long "\\>") ""))
1227 230 : switches))))
1228 :
1229 : (defun dired-switches-escape-p (switches)
1230 : "Return non-nil if the string SWITCHES contains -b or --escape."
1231 : ;; Do not match things like "--block-size" that happen to contain "b".
1232 18 : (dired-check-switches switches "b" "escape"))
1233 :
1234 : (defun dired-switches-recursive-p (switches)
1235 : "Return non-nil if the string SWITCHES contains -R or --recursive."
1236 18 : (dired-check-switches switches "R" "recursive"))
1237 :
1238 : (defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
1239 : "Insert a directory listing of DIR, Dired style.
1240 : Use SWITCHES to make the listings.
1241 : If FILE-LIST is non-nil, list only those files.
1242 : Otherwise, if WILDCARD is non-nil, expand wildcards;
1243 : in that case, DIR should be a file name that uses wildcards.
1244 : In other cases, DIR should be a directory name or a directory filename.
1245 : If HDR is non-nil, insert a header line with the directory name."
1246 6 : (let ((opoint (point))
1247 6 : (process-environment (copy-sequence process-environment))
1248 : end)
1249 6 : (if (and
1250 : ;; Don't try to invoke `ls' if we are on DOS/Windows where
1251 : ;; ls-lisp emulation is used, except if they want to use `ls'
1252 : ;; as indicated by `ls-lisp-use-insert-directory-program'.
1253 6 : (not (and (featurep 'ls-lisp)
1254 6 : (null ls-lisp-use-insert-directory-program)))
1255 6 : (not (and (featurep 'eshell)
1256 6 : (bound-and-true-p eshell-ls-use-in-dired)))
1257 6 : (or (file-remote-p dir)
1258 0 : (if (eq dired-use-ls-dired 'unspecified)
1259 : ;; Check whether "ls --dired" gives exit code 0, and
1260 : ;; save the answer in `dired-use-ls-dired'.
1261 0 : (or (setq dired-use-ls-dired
1262 0 : (eq 0 (call-process insert-directory-program
1263 0 : nil nil nil "--dired")))
1264 0 : (progn
1265 0 : (message "ls does not support --dired; \
1266 0 : see `dired-use-ls-dired' for more details.")
1267 0 : nil))
1268 6 : dired-use-ls-dired)))
1269 6 : (setq switches (concat "--dired " switches)))
1270 : ;; Expand directory wildcards and fill file-list.
1271 6 : (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir)))
1272 6 : (cond (dir-wildcard
1273 4 : (setq switches (concat "-d " switches))
1274 : ;; We don't know whether the remote ls supports
1275 : ;; "--dired", so we cannot add it to the `process-file'
1276 : ;; call for wildcards.
1277 4 : (when (file-remote-p dir)
1278 4 : (setq switches (dired-replace-in-string "--dired" "" switches)))
1279 4 : (let* ((default-directory (car dir-wildcard))
1280 4 : (script (format "ls %s %s" switches (cdr dir-wildcard)))
1281 4 : (remotep (file-remote-p dir))
1282 4 : (sh (or (and remotep "/bin/sh")
1283 0 : (and (bound-and-true-p explicit-shell-file-name)
1284 0 : (executable-find explicit-shell-file-name))
1285 4 : (executable-find "sh")))
1286 4 : (switch (if remotep "-c" shell-command-switch)))
1287 4 : (unless
1288 4 : (zerop
1289 4 : (process-file sh nil (current-buffer) nil switch script))
1290 0 : (user-error
1291 4 : "%s: No files matching wildcard" (cdr dir-wildcard)))
1292 4 : (insert-directory-clean (point) switches)))
1293 : (t
1294 : ;; We used to specify the C locale here, to force English
1295 : ;; month names; but this should not be necessary any
1296 : ;; more, with the new value of
1297 : ;; `directory-listing-before-filename-regexp'.
1298 2 : (if file-list
1299 0 : (dolist (f file-list)
1300 0 : (let ((beg (point)))
1301 0 : (insert-directory f switches nil nil)
1302 : ;; Re-align fields, if necessary.
1303 0 : (dired-align-file beg (point))))
1304 6 : (insert-directory dir switches wildcard (not wildcard))))))
1305 : ;; Quote certain characters, unless ls quoted them for us.
1306 6 : (if (not (dired-switches-escape-p dired-actual-switches))
1307 6 : (save-excursion
1308 6 : (setq end (point-marker))
1309 6 : (goto-char opoint)
1310 38 : (while (search-forward "\\" end t)
1311 32 : (replace-match (apply #'propertize
1312 : "\\\\"
1313 32 : (text-properties-at (match-beginning 0)))
1314 32 : nil t))
1315 6 : (goto-char opoint)
1316 6 : (while (search-forward "\^m" end t)
1317 0 : (replace-match (apply #'propertize
1318 : "\\015"
1319 0 : (text-properties-at (match-beginning 0)))
1320 6 : nil t))
1321 6 : (set-marker end nil))
1322 : ;; Replace any newlines in DIR with literal "\n"s, for the sake
1323 : ;; of the header line. To disambiguate a literal "\n" in the
1324 : ;; actual dirname, we also replace "\" with "\\".
1325 : ;; Personally, I think this should always be done, irrespective
1326 : ;; of the value of dired-actual-switches, because:
1327 : ;; i) Dired simply does not work with an unescaped newline in
1328 : ;; the directory name used in the header (bug=10469#28), and
1329 : ;; ii) "\" is always replaced with "\\" in the listing, so doing
1330 : ;; it in the header as well makes things consistent.
1331 : ;; But at present it is only done if "-b" is in ls-switches,
1332 : ;; because newlines in dirnames are uncommon, and people may
1333 : ;; have gotten used to seeing unescaped "\" in the headers.
1334 : ;; Note: adjust dired-build-subdir-alist if you change this.
1335 0 : (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
1336 6 : dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
1337 : ;; If we used --dired and it worked, the lines are already indented.
1338 : ;; Otherwise, indent them.
1339 6 : (unless (save-excursion
1340 6 : (goto-char opoint)
1341 6 : (looking-at-p " "))
1342 4 : (let ((indent-tabs-mode nil))
1343 6 : (indent-rigidly opoint (point) 2)))
1344 : ;; Insert text at the beginning to standardize things.
1345 6 : (let ((content-point opoint))
1346 6 : (save-excursion
1347 6 : (goto-char opoint)
1348 6 : (when (and (or hdr wildcard)
1349 6 : (not (and (looking-at "^ \\(.*\\):$")
1350 6 : (file-name-absolute-p (match-string 1)))))
1351 : ;; Note that dired-build-subdir-alist will replace the name
1352 : ;; by its expansion, so it does not matter whether what we insert
1353 : ;; here is fully expanded, but it should be absolute.
1354 6 : (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
1355 6 : (directory-file-name (file-name-directory dir))) ":\n")
1356 6 : (setq content-point (point)))
1357 6 : (when wildcard
1358 : ;; Insert "wildcard" line where "total" line would be for a full dir.
1359 6 : (insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir))
1360 6 : (file-name-nondirectory dir))
1361 6 : "\n")))
1362 6 : (dired-insert-set-properties content-point (point)))))
1363 :
1364 : (defun dired-insert-set-properties (beg end)
1365 : "Add various text properties to the lines in the region."
1366 6 : (save-excursion
1367 6 : (goto-char beg)
1368 206 : (while (< (point) end)
1369 200 : (ignore-errors
1370 200 : (if (not (dired-move-to-filename))
1371 6 : (unless (or (looking-at-p "^$")
1372 6 : (looking-at-p dired-subdir-regexp))
1373 6 : (put-text-property (line-beginning-position)
1374 6 : (1+ (line-end-position))
1375 6 : 'invisible 'dired-hide-details-information))
1376 194 : (put-text-property (+ (line-beginning-position) 1) (1- (point))
1377 194 : 'invisible 'dired-hide-details-detail)
1378 194 : (add-text-properties
1379 194 : (point)
1380 194 : (progn
1381 194 : (dired-move-to-end-of-filename)
1382 194 : (point))
1383 : '(mouse-face
1384 : highlight
1385 : dired-filename t
1386 194 : help-echo "mouse-2: visit this file in other window"))
1387 194 : (when (< (+ (point) 4) (line-end-position))
1388 0 : (put-text-property (+ (point) 4) (line-end-position)
1389 200 : 'invisible 'dired-hide-details-link))))
1390 200 : (forward-line 1))))
1391 :
1392 : ;; Reverting a dired buffer
1393 :
1394 : (defun dired-revert (&optional _arg _noconfirm)
1395 : "Reread the Dired buffer.
1396 : Must also be called after `dired-actual-switches' have changed.
1397 : Should not fail even on completely garbaged buffers.
1398 : Preserves old cursor, marks/flags, hidden-p.
1399 :
1400 : Dired sets `revert-buffer-function' to this function. The args
1401 : ARG and NOCONFIRM, passed from `revert-buffer', are ignored."
1402 0 : (widen) ; just in case user narrowed
1403 0 : (let ((modflag (buffer-modified-p))
1404 0 : (positions (dired-save-positions))
1405 : (mark-alist nil) ; save marked files
1406 0 : (hidden-subdirs (dired-remember-hidden))
1407 0 : (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
1408 : (case-fold-search nil) ; we check for upper case ls flags
1409 : (inhibit-read-only t))
1410 0 : (goto-char (point-min))
1411 0 : (setq mark-alist;; only after dired-remember-hidden since this unhides:
1412 0 : (dired-remember-marks (point-min) (point-max)))
1413 : ;; treat top level dir extra (it may contain wildcards)
1414 0 : (if (not (consp dired-directory))
1415 0 : (dired-uncache dired-directory)
1416 0 : (dired-uncache (car dired-directory))
1417 0 : (dolist (dir (cdr dired-directory))
1418 0 : (if (file-name-absolute-p dir)
1419 0 : (dired-uncache dir))))
1420 : ;; Run dired-after-readin-hook just once, below.
1421 0 : (let ((dired-after-readin-hook nil))
1422 0 : (dired-readin)
1423 0 : (dired-insert-old-subdirs old-subdir-alist))
1424 0 : (dired-mark-remembered mark-alist) ; mark files that were marked
1425 : ;; ... run the hook for the whole buffer, and only after markers
1426 : ;; have been reinserted (else omitting in dired-x would omit marked files)
1427 0 : (run-hooks 'dired-after-readin-hook) ; no need to narrow
1428 0 : (dired-restore-positions positions)
1429 0 : (save-excursion ; hide subdirs that were hidden
1430 0 : (dolist (dir hidden-subdirs)
1431 0 : (if (dired-goto-subdir dir)
1432 0 : (dired-hide-subdir 1))))
1433 0 : (unless modflag (restore-buffer-modified-p nil)))
1434 : ;; outside of the let scope
1435 : ;;; Might as well not override the user if the user changed this.
1436 : ;;; (setq buffer-read-only t)
1437 : )
1438 :
1439 : ;; Subroutines of dired-revert
1440 : ;; Some of these are also used when inserting subdirs.
1441 :
1442 : (defun dired-save-positions ()
1443 : "Return current positions in the buffer and all windows with this directory.
1444 : The positions have the form (BUFFER-POSITION WINDOW-POSITIONS).
1445 :
1446 : BUFFER-POSITION is the point position in the current Dired buffer.
1447 : It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER).
1448 :
1449 : WINDOW-POSITIONS are current positions in all windows displaying
1450 : this dired buffer. The window positions have the form (WINDOW
1451 : DIRED-FILENAME WINDOW-LINE-NUMBER).
1452 :
1453 : We store line numbers instead of point positions because the header
1454 : lines might change as well: when this happen the line number doesn't
1455 : change; the point does."
1456 0 : (list
1457 0 : (list (current-buffer) (dired-get-filename nil t) (line-number-at-pos))
1458 0 : (mapcar (lambda (w)
1459 0 : (with-selected-window w
1460 0 : (list w
1461 0 : (dired-get-filename nil t)
1462 0 : (line-number-at-pos (window-point w)))))
1463 0 : (get-buffer-window-list nil 0 t))))
1464 :
1465 : (defun dired-restore-positions (positions)
1466 : "Restore POSITIONS saved with `dired-save-positions'."
1467 0 : (let* ((buf-file-pos (nth 0 positions))
1468 0 : (buffer (nth 0 buf-file-pos)))
1469 0 : (unless (and (nth 1 buf-file-pos)
1470 0 : (dired-goto-file (nth 1 buf-file-pos)))
1471 0 : (goto-char (point-min))
1472 0 : (forward-line (1- (nth 2 buf-file-pos)))
1473 0 : (dired-move-to-filename))
1474 0 : (dolist (win-file-pos (nth 1 positions))
1475 : ;; Ensure that window still displays the original buffer.
1476 0 : (when (eq (window-buffer (nth 0 win-file-pos)) buffer)
1477 0 : (with-selected-window (nth 0 win-file-pos)
1478 0 : (unless (and (nth 1 win-file-pos)
1479 0 : (dired-goto-file (nth 1 win-file-pos)))
1480 0 : (goto-char (point-min))
1481 0 : (forward-line (1- (nth 2 win-file-pos)))
1482 0 : (dired-move-to-filename)))))))
1483 :
1484 : (defun dired-remember-marks (beg end)
1485 : "Return alist of files and their marks, from BEG to END."
1486 0 : (if selective-display ; must unhide to make this work.
1487 0 : (let ((inhibit-read-only t))
1488 0 : (subst-char-in-region beg end ?\r ?\n)))
1489 0 : (let (fil chr alist)
1490 0 : (save-excursion
1491 0 : (goto-char beg)
1492 0 : (while (re-search-forward dired-re-mark end t)
1493 0 : (if (setq fil (dired-get-filename nil t))
1494 0 : (setq chr (preceding-char)
1495 0 : alist (cons (cons fil chr) alist)))))
1496 0 : alist))
1497 :
1498 : (defun dired-mark-remembered (alist)
1499 : "Mark all files remembered in ALIST.
1500 : Each element of ALIST looks like (FILE . MARKERCHAR)."
1501 0 : (let (elt fil chr)
1502 0 : (save-excursion
1503 0 : (while alist
1504 0 : (setq elt (car alist)
1505 0 : alist (cdr alist)
1506 0 : fil (car elt)
1507 0 : chr (cdr elt))
1508 0 : (when (dired-goto-file fil)
1509 0 : (beginning-of-line)
1510 0 : (delete-char 1)
1511 0 : (insert chr))))))
1512 :
1513 : (defun dired-remember-hidden ()
1514 : "Return a list of names of subdirs currently hidden."
1515 0 : (let ((l dired-subdir-alist) dir pos result)
1516 0 : (while l
1517 0 : (setq dir (car (car l))
1518 0 : pos (cdr (car l))
1519 0 : l (cdr l))
1520 0 : (goto-char pos)
1521 0 : (skip-chars-forward "^\r\n")
1522 0 : (if (eq (following-char) ?\r)
1523 0 : (setq result (cons dir result))))
1524 0 : result))
1525 :
1526 : (defun dired-insert-old-subdirs (old-subdir-alist)
1527 : "Try to insert all subdirs that were displayed before.
1528 : Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1529 0 : (or (dired-switches-recursive-p dired-actual-switches)
1530 0 : (let (elt dir)
1531 0 : (while old-subdir-alist
1532 0 : (setq elt (car old-subdir-alist)
1533 0 : old-subdir-alist (cdr old-subdir-alist)
1534 0 : dir (car elt))
1535 0 : (ignore-errors
1536 0 : (dired-uncache dir)
1537 0 : (dired-insert-subdir dir))))))
1538 :
1539 : (defun dired-uncache (dir)
1540 : "Remove directory DIR from any directory cache."
1541 0 : (let ((handler (find-file-name-handler dir 'dired-uncache)))
1542 0 : (if handler
1543 0 : (funcall handler 'dired-uncache dir))))
1544 :
1545 : ;; dired mode key bindings and initialization
1546 :
1547 : (defvar dired-mode-map
1548 : ;; This looks ugly when substitute-command-keys uses C-d instead d:
1549 : ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
1550 : (let ((map (make-keymap)))
1551 : (set-keymap-parent map special-mode-map)
1552 : (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
1553 : (define-key map [follow-link] 'mouse-face)
1554 : ;; Commands to mark or flag certain categories of files
1555 : (define-key map "#" 'dired-flag-auto-save-files)
1556 : (define-key map "." 'dired-clean-directory)
1557 : (define-key map "~" 'dired-flag-backup-files)
1558 : ;; Upper case keys (except !) for operating on the marked files
1559 : (define-key map "A" 'dired-do-find-regexp)
1560 : (define-key map "C" 'dired-do-copy)
1561 : (define-key map "B" 'dired-do-byte-compile)
1562 : (define-key map "D" 'dired-do-delete)
1563 : (define-key map "G" 'dired-do-chgrp)
1564 : (define-key map "H" 'dired-do-hardlink)
1565 : (define-key map "L" 'dired-do-load)
1566 : (define-key map "M" 'dired-do-chmod)
1567 : (define-key map "O" 'dired-do-chown)
1568 : (define-key map "P" 'dired-do-print)
1569 : (define-key map "Q" 'dired-do-find-regexp-and-replace)
1570 : (define-key map "R" 'dired-do-rename)
1571 : (define-key map "S" 'dired-do-symlink)
1572 : (define-key map "T" 'dired-do-touch)
1573 : (define-key map "X" 'dired-do-shell-command)
1574 : (define-key map "Z" 'dired-do-compress)
1575 : (define-key map "c" 'dired-do-compress-to)
1576 : (define-key map "!" 'dired-do-shell-command)
1577 : (define-key map "&" 'dired-do-async-shell-command)
1578 : ;; Comparison commands
1579 : (define-key map "=" 'dired-diff)
1580 : ;; Tree Dired commands
1581 : (define-key map "\M-\C-?" 'dired-unmark-all-files)
1582 : (define-key map "\M-\C-d" 'dired-tree-down)
1583 : (define-key map "\M-\C-u" 'dired-tree-up)
1584 : (define-key map "\M-\C-n" 'dired-next-subdir)
1585 : (define-key map "\M-\C-p" 'dired-prev-subdir)
1586 : ;; move to marked files
1587 : (define-key map "\M-{" 'dired-prev-marked-file)
1588 : (define-key map "\M-}" 'dired-next-marked-file)
1589 : ;; Make all regexp commands share a `%' prefix:
1590 : ;; We used to get to the submap via a symbol dired-regexp-prefix,
1591 : ;; but that seems to serve little purpose, and copy-keymap
1592 : ;; does a better job without it.
1593 : (define-key map "%" nil)
1594 : (define-key map "%u" 'dired-upcase)
1595 : (define-key map "%l" 'dired-downcase)
1596 : (define-key map "%d" 'dired-flag-files-regexp)
1597 : (define-key map "%g" 'dired-mark-files-containing-regexp)
1598 : (define-key map "%m" 'dired-mark-files-regexp)
1599 : (define-key map "%r" 'dired-do-rename-regexp)
1600 : (define-key map "%C" 'dired-do-copy-regexp)
1601 : (define-key map "%H" 'dired-do-hardlink-regexp)
1602 : (define-key map "%R" 'dired-do-rename-regexp)
1603 : (define-key map "%S" 'dired-do-symlink-regexp)
1604 : (define-key map "%&" 'dired-flag-garbage-files)
1605 : ;; Commands for marking and unmarking.
1606 : (define-key map "*" nil)
1607 : (define-key map "**" 'dired-mark-executables)
1608 : (define-key map "*/" 'dired-mark-directories)
1609 : (define-key map "*@" 'dired-mark-symlinks)
1610 : (define-key map "*%" 'dired-mark-files-regexp)
1611 : (define-key map "*c" 'dired-change-marks)
1612 : (define-key map "*s" 'dired-mark-subdir-files)
1613 : (define-key map "*m" 'dired-mark)
1614 : (define-key map "*u" 'dired-unmark)
1615 : (define-key map "*?" 'dired-unmark-all-files)
1616 : (define-key map "*!" 'dired-unmark-all-marks)
1617 : (define-key map "U" 'dired-unmark-all-marks)
1618 : (define-key map "*\177" 'dired-unmark-backward)
1619 : (define-key map "*\C-n" 'dired-next-marked-file)
1620 : (define-key map "*\C-p" 'dired-prev-marked-file)
1621 : (define-key map "*t" 'dired-toggle-marks)
1622 : ;; Lower keys for commands not operating on all the marked files
1623 : (define-key map "a" 'dired-find-alternate-file)
1624 : (define-key map "d" 'dired-flag-file-deletion)
1625 : (define-key map "e" 'dired-find-file)
1626 : (define-key map "f" 'dired-find-file)
1627 : (define-key map "\C-m" 'dired-find-file)
1628 : (put 'dired-find-file :advertised-binding "\C-m")
1629 : (define-key map "g" 'revert-buffer)
1630 : (define-key map "i" 'dired-maybe-insert-subdir)
1631 : (define-key map "j" 'dired-goto-file)
1632 : (define-key map "k" 'dired-do-kill-lines)
1633 : (define-key map "l" 'dired-do-redisplay)
1634 : (define-key map "m" 'dired-mark)
1635 : (define-key map "n" 'dired-next-line)
1636 : (define-key map "o" 'dired-find-file-other-window)
1637 : (define-key map "\C-o" 'dired-display-file)
1638 : (define-key map "p" 'dired-previous-line)
1639 : (define-key map "s" 'dired-sort-toggle-or-edit)
1640 : (define-key map "t" 'dired-toggle-marks)
1641 : (define-key map "u" 'dired-unmark)
1642 : (define-key map "v" 'dired-view-file)
1643 : (define-key map "w" 'dired-copy-filename-as-kill)
1644 : (define-key map "W" 'browse-url-of-dired-file)
1645 : (define-key map "x" 'dired-do-flagged-delete)
1646 : (define-key map "y" 'dired-show-file-type)
1647 : (define-key map "+" 'dired-create-directory)
1648 : ;; moving
1649 : (define-key map "<" 'dired-prev-dirline)
1650 : (define-key map ">" 'dired-next-dirline)
1651 : (define-key map "^" 'dired-up-directory)
1652 : (define-key map " " 'dired-next-line)
1653 : (define-key map [?\S-\ ] 'dired-previous-line)
1654 : (define-key map [remap next-line] 'dired-next-line)
1655 : (define-key map [remap previous-line] 'dired-previous-line)
1656 : ;; hiding
1657 : (define-key map "$" 'dired-hide-subdir)
1658 : (define-key map "\M-$" 'dired-hide-all)
1659 : (define-key map "(" 'dired-hide-details-mode)
1660 : ;; isearch
1661 : (define-key map (kbd "M-s a C-s") 'dired-do-isearch)
1662 : (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp)
1663 : (define-key map (kbd "M-s f C-s") 'dired-isearch-filenames)
1664 : (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
1665 : ;; misc
1666 : (define-key map [remap read-only-mode] 'dired-toggle-read-only)
1667 : ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
1668 : (define-key map [remap toggle-read-only] 'dired-toggle-read-only)
1669 : (define-key map "?" 'dired-summary)
1670 : (define-key map "\177" 'dired-unmark-backward)
1671 : (define-key map [remap undo] 'dired-undo)
1672 : (define-key map [remap advertised-undo] 'dired-undo)
1673 : ;; thumbnail manipulation (image-dired)
1674 : (define-key map "\C-td" 'image-dired-display-thumbs)
1675 : (define-key map "\C-tt" 'image-dired-tag-files)
1676 : (define-key map "\C-tr" 'image-dired-delete-tag)
1677 : (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer)
1678 : (define-key map "\C-ti" 'image-dired-dired-display-image)
1679 : (define-key map "\C-tx" 'image-dired-dired-display-external)
1680 : (define-key map "\C-ta" 'image-dired-display-thumbs-append)
1681 : (define-key map "\C-t." 'image-dired-display-thumb)
1682 : (define-key map "\C-tc" 'image-dired-dired-comment-files)
1683 : (define-key map "\C-tf" 'image-dired-mark-tagged-files)
1684 : (define-key map "\C-t\C-t" 'image-dired-dired-toggle-marked-thumbs)
1685 : (define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags)
1686 : ;; encryption and decryption (epa-dired)
1687 : (define-key map ":d" 'epa-dired-do-decrypt)
1688 : (define-key map ":v" 'epa-dired-do-verify)
1689 : (define-key map ":s" 'epa-dired-do-sign)
1690 : (define-key map ":e" 'epa-dired-do-encrypt)
1691 :
1692 : ;; Make menu bar items.
1693 :
1694 : ;; No need to fo this, now that top-level items are fewer.
1695 : ;;;;
1696 : ;; Get rid of the Edit menu bar item to save space.
1697 : ;(define-key map [menu-bar edit] 'undefined)
1698 :
1699 : (define-key map [menu-bar subdir]
1700 : (cons "Subdir" (make-sparse-keymap "Subdir")))
1701 :
1702 : (define-key map [menu-bar subdir hide-all]
1703 : '(menu-item "Hide All" dired-hide-all
1704 : :help "Hide all subdirectories, leave only header lines"))
1705 : (define-key map [menu-bar subdir hide-subdir]
1706 : '(menu-item "Hide/UnHide Subdir" dired-hide-subdir
1707 : :help "Hide or unhide current directory listing"))
1708 : (define-key map [menu-bar subdir tree-down]
1709 : '(menu-item "Tree Down" dired-tree-down
1710 : :help "Go to first subdirectory header down the tree"))
1711 : (define-key map [menu-bar subdir tree-up]
1712 : '(menu-item "Tree Up" dired-tree-up
1713 : :help "Go to first subdirectory header up the tree"))
1714 : (define-key map [menu-bar subdir up]
1715 : '(menu-item "Up Directory" dired-up-directory
1716 : :help "Edit the parent directory"))
1717 : (define-key map [menu-bar subdir prev-subdir]
1718 : '(menu-item "Prev Subdir" dired-prev-subdir
1719 : :help "Go to previous subdirectory header line"))
1720 : (define-key map [menu-bar subdir next-subdir]
1721 : '(menu-item "Next Subdir" dired-next-subdir
1722 : :help "Go to next subdirectory header line"))
1723 : (define-key map [menu-bar subdir prev-dirline]
1724 : '(menu-item "Prev Dirline" dired-prev-dirline
1725 : :help "Move to next directory-file line"))
1726 : (define-key map [menu-bar subdir next-dirline]
1727 : '(menu-item "Next Dirline" dired-next-dirline
1728 : :help "Move to previous directory-file line"))
1729 : (define-key map [menu-bar subdir insert]
1730 : '(menu-item "Insert This Subdir" dired-maybe-insert-subdir
1731 : :help "Insert contents of subdirectory"
1732 : :enable (let ((f (dired-get-filename nil t)))
1733 : (and f (file-directory-p f)))))
1734 : (define-key map [menu-bar immediate]
1735 : (cons "Immediate" (make-sparse-keymap "Immediate")))
1736 :
1737 : (define-key map
1738 : [menu-bar immediate image-dired-dired-display-external]
1739 : '(menu-item "Display Image Externally" image-dired-dired-display-external
1740 : :help "Display image in external viewer"))
1741 : (define-key map
1742 : [menu-bar immediate image-dired-dired-display-image]
1743 : '(menu-item "Display Image" image-dired-dired-display-image
1744 : :help "Display sized image in a separate window"))
1745 : (define-key map
1746 : [menu-bar immediate image-dired-dired-toggle-marked-thumbs]
1747 : '(menu-item "Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs
1748 : :help "Add or remove image thumbnails in front of marked file names"))
1749 :
1750 : (define-key map [menu-bar immediate hide-details]
1751 : '(menu-item "Hide Details" dired-hide-details-mode
1752 : :help "Hide details in buffer"
1753 : :button (:toggle . dired-hide-details-mode)))
1754 : (define-key map [menu-bar immediate revert-buffer]
1755 : '(menu-item "Refresh" revert-buffer
1756 : :help "Update contents of shown directories"))
1757 :
1758 : (define-key map [menu-bar immediate dashes]
1759 : '("--"))
1760 :
1761 : (define-key map [menu-bar immediate isearch-filenames-regexp]
1762 : '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
1763 : :help "Incrementally search for regexp in file names only"))
1764 : (define-key map [menu-bar immediate isearch-filenames]
1765 : '(menu-item "Isearch in File Names..." dired-isearch-filenames
1766 : :help "Incrementally search for string in file names only."))
1767 : (define-key map [menu-bar immediate compare-directories]
1768 : '(menu-item "Compare Directories..." dired-compare-directories
1769 : :help "Mark files with different attributes in two Dired buffers"))
1770 : (define-key map [menu-bar immediate backup-diff]
1771 : '(menu-item "Compare with Backup" dired-backup-diff
1772 : :help "Diff file at cursor with its latest backup"))
1773 : (define-key map [menu-bar immediate diff]
1774 : '(menu-item "Diff..." dired-diff
1775 : :help "Compare file at cursor with another file"))
1776 : (define-key map [menu-bar immediate view]
1777 : '(menu-item "View This File" dired-view-file
1778 : :help "Examine file at cursor in read-only mode"))
1779 : (define-key map [menu-bar immediate display]
1780 : '(menu-item "Display in Other Window" dired-display-file
1781 : :help "Display file at cursor in other window"))
1782 : (define-key map [menu-bar immediate find-file-other-window]
1783 : '(menu-item "Find in Other Window" dired-find-file-other-window
1784 : :help "Edit file at cursor in other window"))
1785 : (define-key map [menu-bar immediate find-file]
1786 : '(menu-item "Find This File" dired-find-file
1787 : :help "Edit file at cursor"))
1788 : (define-key map [menu-bar immediate create-directory]
1789 : '(menu-item "Create Directory..." dired-create-directory
1790 : :help "Create a directory"))
1791 : (define-key map [menu-bar immediate wdired-mode]
1792 : '(menu-item "Edit File Names" wdired-change-to-wdired-mode
1793 : :help "Put a Dired buffer in a mode in which filenames are editable"
1794 : :keys "C-x C-q"
1795 : :filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
1796 :
1797 : (define-key map [menu-bar regexp]
1798 : (cons "Regexp" (make-sparse-keymap "Regexp")))
1799 :
1800 : (define-key map
1801 : [menu-bar regexp image-dired-mark-tagged-files]
1802 : '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files
1803 : :help "Mark files whose image tags matches regexp"))
1804 :
1805 : (define-key map [menu-bar regexp dashes-1]
1806 : '("--"))
1807 :
1808 : (define-key map [menu-bar regexp downcase]
1809 : '(menu-item "Downcase" dired-downcase
1810 : ;; When running on plain MS-DOS, there's only one
1811 : ;; letter-case for file names.
1812 : :enable (or (not (fboundp 'msdos-long-file-names))
1813 : (msdos-long-file-names))
1814 : :help "Rename marked files to lower-case name"))
1815 : (define-key map [menu-bar regexp upcase]
1816 : '(menu-item "Upcase" dired-upcase
1817 : :enable (or (not (fboundp 'msdos-long-file-names))
1818 : (msdos-long-file-names))
1819 : :help "Rename marked files to upper-case name"))
1820 : (define-key map [menu-bar regexp hardlink]
1821 : '(menu-item "Hardlink..." dired-do-hardlink-regexp
1822 : :help "Make hard links for files matching regexp"))
1823 : (define-key map [menu-bar regexp symlink]
1824 : '(menu-item "Symlink..." dired-do-symlink-regexp
1825 : :visible (fboundp 'make-symbolic-link)
1826 : :help "Make symbolic links for files matching regexp"))
1827 : (define-key map [menu-bar regexp rename]
1828 : '(menu-item "Rename..." dired-do-rename-regexp
1829 : :help "Rename marked files matching regexp"))
1830 : (define-key map [menu-bar regexp copy]
1831 : '(menu-item "Copy..." dired-do-copy-regexp
1832 : :help "Copy marked files matching regexp"))
1833 : (define-key map [menu-bar regexp flag]
1834 : '(menu-item "Flag..." dired-flag-files-regexp
1835 : :help "Flag files matching regexp for deletion"))
1836 : (define-key map [menu-bar regexp mark]
1837 : '(menu-item "Mark..." dired-mark-files-regexp
1838 : :help "Mark files matching regexp for future operations"))
1839 : (define-key map [menu-bar regexp mark-cont]
1840 : '(menu-item "Mark Containing..." dired-mark-files-containing-regexp
1841 : :help "Mark files whose contents matches regexp"))
1842 :
1843 : (define-key map [menu-bar mark]
1844 : (cons "Mark" (make-sparse-keymap "Mark")))
1845 :
1846 : (define-key map [menu-bar mark prev]
1847 : '(menu-item "Previous Marked" dired-prev-marked-file
1848 : :help "Move to previous marked file"))
1849 : (define-key map [menu-bar mark next]
1850 : '(menu-item "Next Marked" dired-next-marked-file
1851 : :help "Move to next marked file"))
1852 : (define-key map [menu-bar mark marks]
1853 : '(menu-item "Change Marks..." dired-change-marks
1854 : :help "Replace marker with another character"))
1855 : (define-key map [menu-bar mark unmark-all]
1856 : '(menu-item "Unmark All" dired-unmark-all-marks))
1857 : (define-key map [menu-bar mark symlinks]
1858 : '(menu-item "Mark Symlinks" dired-mark-symlinks
1859 : :visible (fboundp 'make-symbolic-link)
1860 : :help "Mark all symbolic links"))
1861 : (define-key map [menu-bar mark directories]
1862 : '(menu-item "Mark Directories" dired-mark-directories
1863 : :help "Mark all directories except `.' and `..'"))
1864 : (define-key map [menu-bar mark directory]
1865 : '(menu-item "Mark Old Backups" dired-clean-directory
1866 : :help "Flag old numbered backups for deletion"))
1867 : (define-key map [menu-bar mark executables]
1868 : '(menu-item "Mark Executables" dired-mark-executables
1869 : :help "Mark all executable files"))
1870 : (define-key map [menu-bar mark garbage-files]
1871 : '(menu-item "Flag Garbage Files" dired-flag-garbage-files
1872 : :help "Flag unneeded files for deletion"))
1873 : (define-key map [menu-bar mark backup-files]
1874 : '(menu-item "Flag Backup Files" dired-flag-backup-files
1875 : :help "Flag all backup files for deletion"))
1876 : (define-key map [menu-bar mark auto-save-files]
1877 : '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
1878 : :help "Flag auto-save files for deletion"))
1879 : (define-key map [menu-bar mark deletion]
1880 : '(menu-item "Flag" dired-flag-file-deletion
1881 : :help "Flag current line's file for deletion"))
1882 : (define-key map [menu-bar mark unmark]
1883 : '(menu-item "Unmark" dired-unmark
1884 : :help "Unmark or unflag current line's file"))
1885 : (define-key map [menu-bar mark mark]
1886 : '(menu-item "Mark" dired-mark
1887 : :help "Mark current line's file for future operations"))
1888 : (define-key map [menu-bar mark toggle-marks]
1889 : '(menu-item "Toggle Marks" dired-toggle-marks
1890 : :help "Mark unmarked files, unmark marked ones"))
1891 :
1892 : (define-key map [menu-bar operate]
1893 : (cons "Operate" (make-sparse-keymap "Operate")))
1894 :
1895 : (define-key map
1896 : [menu-bar operate image-dired-delete-tag]
1897 : '(menu-item "Delete Image Tag..." image-dired-delete-tag
1898 : :help "Delete image tag from current or marked files"))
1899 : (define-key map
1900 : [menu-bar operate image-dired-tag-files]
1901 : '(menu-item "Add Image Tags..." image-dired-tag-files
1902 : :help "Add image tags to current or marked files"))
1903 : (define-key map
1904 : [menu-bar operate image-dired-dired-comment-files]
1905 : '(menu-item "Add Image Comment..." image-dired-dired-comment-files
1906 : :help "Add image comment to current or marked files"))
1907 : (define-key map
1908 : [menu-bar operate image-dired-display-thumbs]
1909 : '(menu-item "Display Image Thumbnails" image-dired-display-thumbs
1910 : :help "Display image thumbnails for current or marked image files"))
1911 :
1912 : (define-key map [menu-bar operate dashes-4]
1913 : '("--"))
1914 :
1915 : (define-key map
1916 : [menu-bar operate epa-dired-do-decrypt]
1917 : '(menu-item "Decrypt..." epa-dired-do-decrypt
1918 : :help "Decrypt current or marked files"))
1919 :
1920 : (define-key map
1921 : [menu-bar operate epa-dired-do-verify]
1922 : '(menu-item "Verify" epa-dired-do-verify
1923 : :help "Verify digital signature of current or marked files"))
1924 :
1925 : (define-key map
1926 : [menu-bar operate epa-dired-do-sign]
1927 : '(menu-item "Sign..." epa-dired-do-sign
1928 : :help "Create digital signature of current or marked files"))
1929 :
1930 : (define-key map
1931 : [menu-bar operate epa-dired-do-encrypt]
1932 : '(menu-item "Encrypt..." epa-dired-do-encrypt
1933 : :help "Encrypt current or marked files"))
1934 :
1935 : (define-key map [menu-bar operate dashes-3]
1936 : '("--"))
1937 :
1938 : (define-key map [menu-bar operate query-replace]
1939 : '(menu-item "Query Replace in Files..." dired-do-find-regexp-and-replace
1940 : :help "Replace regexp matches in marked files"))
1941 : (define-key map [menu-bar operate search]
1942 : '(menu-item "Search Files..." dired-do-find-regexp
1943 : :help "Search marked files for matches of regexp"))
1944 : (define-key map [menu-bar operate isearch-regexp]
1945 : '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
1946 : :help "Incrementally search marked files for regexp"))
1947 : (define-key map [menu-bar operate isearch]
1948 : '(menu-item "Isearch Files..." dired-do-isearch
1949 : :help "Incrementally search marked files for string"))
1950 : (define-key map [menu-bar operate chown]
1951 : '(menu-item "Change Owner..." dired-do-chown
1952 : :visible (not (memq system-type '(ms-dos windows-nt)))
1953 : :help "Change the owner of marked files"))
1954 : (define-key map [menu-bar operate chgrp]
1955 : '(menu-item "Change Group..." dired-do-chgrp
1956 : :visible (not (memq system-type '(ms-dos windows-nt)))
1957 : :help "Change the group of marked files"))
1958 : (define-key map [menu-bar operate chmod]
1959 : '(menu-item "Change Mode..." dired-do-chmod
1960 : :help "Change mode (attributes) of marked files"))
1961 : (define-key map [menu-bar operate touch]
1962 : '(menu-item "Change Timestamp..." dired-do-touch
1963 : :help "Change timestamp of marked files"))
1964 : (define-key map [menu-bar operate load]
1965 : '(menu-item "Load" dired-do-load
1966 : :help "Load marked Emacs Lisp files"))
1967 : (define-key map [menu-bar operate compile]
1968 : '(menu-item "Byte-compile" dired-do-byte-compile
1969 : :help "Byte-compile marked Emacs Lisp files"))
1970 : (define-key map [menu-bar operate compress]
1971 : '(menu-item "Compress" dired-do-compress
1972 : :help "Compress/uncompress marked files"))
1973 : (define-key map [menu-bar operate print]
1974 : '(menu-item "Print..." dired-do-print
1975 : :help "Ask for print command and print marked files"))
1976 : (define-key map [menu-bar operate hardlink]
1977 : '(menu-item "Hardlink to..." dired-do-hardlink
1978 : :help "Make hard links for current or marked files"))
1979 : (define-key map [menu-bar operate symlink]
1980 : '(menu-item "Symlink to..." dired-do-symlink
1981 : :visible (fboundp 'make-symbolic-link)
1982 : :help "Make symbolic links for current or marked files"))
1983 : (define-key map [menu-bar operate async-command]
1984 : '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command
1985 : :help "Run a shell command asynchronously on current or marked files"))
1986 : (define-key map [menu-bar operate command]
1987 : '(menu-item "Shell Command..." dired-do-shell-command
1988 : :help "Run a shell command on current or marked files"))
1989 : (define-key map [menu-bar operate delete]
1990 : '(menu-item "Delete" dired-do-delete
1991 : :help "Delete current file or all marked files"))
1992 : (define-key map [menu-bar operate rename]
1993 : '(menu-item "Rename to..." dired-do-rename
1994 : :help "Rename current file or move marked files"))
1995 : (define-key map [menu-bar operate copy]
1996 : '(menu-item "Copy to..." dired-do-copy
1997 : :help "Copy current file or all marked files"))
1998 :
1999 : map)
2000 : "Local keymap for Dired mode buffers.")
2001 :
2002 : ;; Dired mode is suitable only for specially formatted data.
2003 : (put 'dired-mode 'mode-class 'special)
2004 :
2005 : ;; Autoload cookie needed by desktop.el
2006 : ;;;###autoload
2007 : (defun dired-mode (&optional dirname switches)
2008 : "\
2009 : Mode for \"editing\" directory listings.
2010 : In Dired, you are \"editing\" a list of the files in a directory and
2011 : (optionally) its subdirectories, in the format of `ls -lR'.
2012 : Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
2013 : \"Editing\" means that you can run shell commands on files, visit,
2014 : compress, load or byte-compile them, change their file attributes
2015 : and insert subdirectories into the same buffer. You can \"mark\"
2016 : files for later commands or \"flag\" them for deletion, either file
2017 : by file or all files matching certain criteria.
2018 : You can move using the usual cursor motion commands.\\<dired-mode-map>
2019 : The buffer is read-only. Digits are prefix arguments.
2020 : Type \\[dired-flag-file-deletion] to flag a file `D' for deletion.
2021 : Type \\[dired-mark] to Mark a file or subdirectory for later commands.
2022 : Most commands operate on the marked files and use the current file
2023 : if no files are marked. Use a numeric prefix argument to operate on
2024 : the next ARG (or previous -ARG if ARG<0) files, or just `1'
2025 : to operate on the current file only. Prefix arguments override marks.
2026 : Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
2027 : to see why something went wrong.
2028 : Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
2029 : Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
2030 : Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'.
2031 : Type \\[dired-find-file] to Find the current line's file
2032 : (or dired it in another buffer, if it is a directory).
2033 : Type \\[dired-find-file-other-window] to find file or Dired directory in Other window.
2034 : Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
2035 : Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
2036 : Type \\[dired-do-copy] to Copy files.
2037 : Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
2038 : Type \\[revert-buffer] to read all currently expanded directories aGain.
2039 : This retains all marks and hides subdirs again that were hidden before.
2040 : Use `SPC' and `DEL' to move down and up by lines.
2041 :
2042 : If Dired ever gets confused, you can either type \\[revert-buffer] \
2043 : to read the
2044 : directories again, type \\[dired-do-redisplay] \
2045 : to relist the file at point or the marked files or a
2046 : subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
2047 : again for the directory tree.
2048 :
2049 : Customization variables (rename this buffer and type \\[describe-variable] on each line
2050 : for more info):
2051 :
2052 : `dired-listing-switches'
2053 : `dired-trivial-filenames'
2054 : `dired-marker-char'
2055 : `dired-del-marker'
2056 : `dired-keep-marker-rename'
2057 : `dired-keep-marker-copy'
2058 : `dired-keep-marker-hardlink'
2059 : `dired-keep-marker-symlink'
2060 :
2061 : Hooks (use \\[describe-variable] to see their documentation):
2062 :
2063 : `dired-before-readin-hook'
2064 : `dired-after-readin-hook'
2065 : `dired-mode-hook'
2066 : `dired-load-hook'
2067 :
2068 : Keybindings:
2069 : \\{dired-mode-map}"
2070 : ;; Not to be called interactively (e.g. dired-directory will be set
2071 : ;; to default-directory, which is wrong with wildcards).
2072 6 : (kill-all-local-variables)
2073 6 : (use-local-map dired-mode-map)
2074 6 : (dired-advertise) ; default-directory is already set
2075 6 : (setq major-mode 'dired-mode
2076 : mode-name "Dired"
2077 : ;; case-fold-search nil
2078 : buffer-read-only t
2079 : selective-display t ; for subdirectory hiding
2080 : mode-line-buffer-identification
2081 6 : (propertized-buffer-identification "%17b"))
2082 : ;; Ignore dired-hide-details-* value of invisible text property by default.
2083 6 : (when (eq buffer-invisibility-spec t)
2084 6 : (setq buffer-invisibility-spec (list t)))
2085 6 : (setq-local revert-buffer-function #'dired-revert)
2086 6 : (setq-local buffer-stale-function #'dired-buffer-stale-p)
2087 6 : (setq-local page-delimiter "\n\n")
2088 6 : (setq-local dired-directory (or dirname default-directory))
2089 : ;; list-buffers uses this to display the dir being edited in this buffer.
2090 6 : (setq list-buffers-directory
2091 6 : (expand-file-name (if (listp dired-directory)
2092 0 : (car dired-directory)
2093 6 : dired-directory)))
2094 6 : (setq-local dired-actual-switches (or switches dired-listing-switches))
2095 6 : (setq-local font-lock-defaults
2096 6 : '(dired-font-lock-keywords t nil nil beginning-of-line))
2097 6 : (setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data)
2098 6 : (setq dired-switches-alist nil)
2099 6 : (hack-dir-local-variables-non-file-buffer) ; before sorting
2100 6 : (dired-sort-other dired-actual-switches t)
2101 6 : (when (featurep 'dnd)
2102 6 : (setq-local dnd-protocol-alist
2103 6 : (append dired-dnd-protocol-alist dnd-protocol-alist)))
2104 6 : (add-hook 'file-name-at-point-functions 'dired-file-name-at-point nil t)
2105 6 : (add-hook 'isearch-mode-hook 'dired-isearch-filenames-setup nil t)
2106 6 : (run-mode-hooks 'dired-mode-hook))
2107 :
2108 : ;; Idiosyncratic dired commands that don't deal with marks.
2109 :
2110 : (defun dired-summary ()
2111 : "Summarize basic Dired commands and show recent Dired errors."
2112 : (interactive)
2113 0 : (dired-why)
2114 : ;>> this should check the key-bindings and use substitute-command-keys if non-standard
2115 0 : (message
2116 0 : "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
2117 :
2118 : (defun dired-undo ()
2119 : "Undo in a Dired buffer.
2120 : This doesn't recover lost files, it just undoes changes in the buffer itself.
2121 : You can use it to recover marks, killed lines or subdirs."
2122 : (interactive)
2123 0 : (let ((inhibit-read-only t))
2124 0 : (undo))
2125 0 : (dired-build-subdir-alist)
2126 0 : (message "Change in Dired buffer undone.
2127 0 : Actual changes in files cannot be undone by Emacs."))
2128 :
2129 : (defun dired-toggle-read-only ()
2130 : "Edit Dired buffer with Wdired, or make it read-only.
2131 : If the current buffer can be edited with Wdired, (i.e. the major
2132 : mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
2133 : Otherwise, toggle `read-only-mode'."
2134 : (interactive)
2135 0 : (if (derived-mode-p 'dired-mode)
2136 0 : (wdired-change-to-wdired-mode)
2137 0 : (read-only-mode 'toggle)))
2138 :
2139 : (defun dired-next-line (arg)
2140 : "Move down lines then position at filename.
2141 : Optional prefix ARG says how many lines to move; default is one line."
2142 : (interactive "^p")
2143 0 : (let ((line-move-visual)
2144 : (goal-column))
2145 0 : (line-move arg t))
2146 : ;; We never want to move point into an invisible line.
2147 0 : (while (and (invisible-p (point))
2148 0 : (not (if (and arg (< arg 0)) (bobp) (eobp))))
2149 0 : (forward-char (if (and arg (< arg 0)) -1 1)))
2150 0 : (dired-move-to-filename))
2151 :
2152 : (defun dired-previous-line (arg)
2153 : "Move up lines then position at filename.
2154 : Optional prefix ARG says how many lines to move; default is one line."
2155 : (interactive "^p")
2156 0 : (dired-next-line (- (or arg 1))))
2157 :
2158 : (defun dired-next-dirline (arg &optional opoint)
2159 : "Goto ARGth next directory file line."
2160 : (interactive "p")
2161 0 : (or opoint (setq opoint (point)))
2162 0 : (if (if (> arg 0)
2163 0 : (re-search-forward dired-re-dir nil t arg)
2164 0 : (beginning-of-line)
2165 0 : (re-search-backward dired-re-dir nil t (- arg)))
2166 0 : (dired-move-to-filename) ; user may type `i' or `f'
2167 0 : (goto-char opoint)
2168 0 : (error "No more subdirectories")))
2169 :
2170 : (defun dired-prev-dirline (arg)
2171 : "Goto ARGth previous directory file line."
2172 : (interactive "p")
2173 0 : (dired-next-dirline (- arg)))
2174 :
2175 : (defun dired-up-directory (&optional other-window)
2176 : "Run Dired on parent directory of current directory.
2177 : Find the parent directory either in this buffer or another buffer.
2178 : Creates a buffer if necessary.
2179 : If OTHER-WINDOW (the optional prefix arg), display the parent
2180 : directory in another window."
2181 : (interactive "P")
2182 0 : (let* ((dir (dired-current-directory))
2183 0 : (up (file-name-directory (directory-file-name dir))))
2184 0 : (or (dired-goto-file (directory-file-name dir))
2185 : ;; Only try dired-goto-subdir if buffer has more than one dir.
2186 0 : (and (cdr dired-subdir-alist)
2187 0 : (dired-goto-subdir up))
2188 0 : (progn
2189 0 : (if other-window
2190 0 : (dired-other-window up)
2191 0 : (dired up))
2192 0 : (dired-goto-file dir)))))
2193 :
2194 : (defun dired-get-file-for-visit ()
2195 : "Get the current line's file name, with an error if file does not exist."
2196 : (interactive)
2197 : ;; We pass t for second arg so that we don't get error for `.' and `..'.
2198 0 : (let ((raw (dired-get-filename nil t))
2199 : file-name)
2200 0 : (if (null raw)
2201 0 : (error "No file on this line"))
2202 0 : (setq file-name (file-name-sans-versions raw t))
2203 0 : (if (file-exists-p file-name)
2204 0 : file-name
2205 0 : (if (file-symlink-p file-name)
2206 0 : (error "File is a symlink to a nonexistent target")
2207 0 : (error "File no longer exists; type `g' to update Dired buffer")))))
2208 :
2209 : ;; Force C-m keybinding rather than `f' or `e' in the mode doc:
2210 : (define-obsolete-function-alias 'dired-advertised-find-file 'dired-find-file "23.2")
2211 : (defun dired-find-file ()
2212 : "In Dired, visit the file or directory named on this line."
2213 : (interactive)
2214 : ;; Bind `find-file-run-dired' so that the command works on directories
2215 : ;; too, independent of the user's setting.
2216 0 : (let ((find-file-run-dired t)
2217 : ;; This binding prevents problems with preserving point in
2218 : ;; windows displaying Dired buffers, because reverting a Dired
2219 : ;; buffer empties it, which changes the places where the
2220 : ;; markers used by switch-to-buffer-preserve-window-point
2221 : ;; point.
2222 : (switch-to-buffer-preserve-window-point
2223 0 : (if dired-auto-revert-buffer
2224 : nil
2225 0 : switch-to-buffer-preserve-window-point)))
2226 0 : (find-file (dired-get-file-for-visit))))
2227 :
2228 : (defun dired-find-alternate-file ()
2229 : "In Dired, visit this file or directory instead of the Dired buffer."
2230 : (interactive)
2231 0 : (set-buffer-modified-p nil)
2232 0 : (find-alternate-file (dired-get-file-for-visit)))
2233 : ;; Don't override the setting from .emacs.
2234 : ;;;###autoload (put 'dired-find-alternate-file 'disabled t)
2235 :
2236 : (defun dired-mouse-find-file-other-window (event)
2237 : "In Dired, visit the file or directory name you click on."
2238 : (interactive "e")
2239 0 : (let (window pos file)
2240 0 : (save-excursion
2241 0 : (setq window (posn-window (event-end event))
2242 0 : pos (posn-point (event-end event)))
2243 0 : (if (not (windowp window))
2244 0 : (error "No file chosen"))
2245 0 : (set-buffer (window-buffer window))
2246 0 : (goto-char pos)
2247 0 : (setq file (dired-get-file-for-visit)))
2248 0 : (if (file-directory-p file)
2249 0 : (or (and (cdr dired-subdir-alist)
2250 0 : (dired-goto-subdir file))
2251 0 : (progn
2252 0 : (select-window window)
2253 0 : (dired-other-window file)))
2254 0 : (select-window window)
2255 0 : (find-file-other-window (file-name-sans-versions file t)))))
2256 :
2257 : (defun dired-view-file ()
2258 : "In Dired, examine a file in view mode, returning to Dired when done.
2259 : When file is a directory, show it in this buffer if it is inserted.
2260 : Otherwise, display it in another buffer."
2261 : (interactive)
2262 0 : (let ((file (dired-get-file-for-visit)))
2263 0 : (if (file-directory-p file)
2264 0 : (or (and (cdr dired-subdir-alist)
2265 0 : (dired-goto-subdir file))
2266 0 : (dired file))
2267 0 : (view-file file))))
2268 :
2269 : (defun dired-find-file-other-window ()
2270 : "In Dired, visit this file or directory in another window."
2271 : (interactive)
2272 0 : (find-file-other-window (dired-get-file-for-visit)))
2273 :
2274 : (defun dired-display-file ()
2275 : "In Dired, display this file or directory in another window."
2276 : (interactive)
2277 0 : (display-buffer (find-file-noselect (dired-get-file-for-visit))
2278 0 : t))
2279 :
2280 : ;;; Functions for extracting and manipulating file names in Dired buffers.
2281 :
2282 : (defun dired-get-filename (&optional localp no-error-if-not-filep)
2283 : "In Dired, return name of file mentioned on this line.
2284 : Value returned normally includes the directory name.
2285 : Optional arg LOCALP with value `no-dir' means don't include directory
2286 : name in result. A value of `verbatim' means to return the name exactly as
2287 : it occurs in the buffer, and a value of t means construct name relative to
2288 : `default-directory', which still may contain slashes if in a subdirectory.
2289 : Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
2290 : regular filenames and return nil if no filename on this line.
2291 : Otherwise, an error occurs in these cases."
2292 6 : (let (case-fold-search file p1 p2 already-absolute)
2293 6 : (save-excursion
2294 6 : (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
2295 6 : (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
2296 : ;; nil if no file on this line, but no-error-if-not-filep is t:
2297 6 : (if (setq file (and p1 p2 (buffer-substring p1 p2)))
2298 6 : (progn
2299 : ;; Get rid of the mouse-face property that file names have.
2300 6 : (set-text-properties 0 (length file) nil file)
2301 : ;; Unquote names quoted by ls or by dired-insert-directory.
2302 : ;; This code was written using `read' to unquote, because
2303 : ;; it's faster than substituting \007 (4 chars) -> ^G (1
2304 : ;; char) etc. in a lisp loop. Unfortunately, this decision
2305 : ;; has necessitated hacks such as dealing with filenames
2306 : ;; with quotation marks in their names.
2307 6 : (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file)
2308 6 : (setq file (replace-match "\\\"" nil t file 1)))
2309 : ;; Unescape any spaces escaped by ls -b (bug#10469).
2310 : ;; Other -b quotes, eg \t, \n, work transparently.
2311 6 : (if (dired-switches-escape-p dired-actual-switches)
2312 0 : (let ((start 0)
2313 : (rep "")
2314 : (shift -1))
2315 0 : (if (eq localp 'verbatim)
2316 0 : (setq rep "\\\\"
2317 0 : shift +1))
2318 0 : (while (string-match "\\(\\\\\\) " file start)
2319 0 : (setq file (replace-match rep nil t file 1)
2320 6 : start (+ shift (match-end 0))))))
2321 6 : (when (eq system-type 'windows-nt)
2322 0 : (save-match-data
2323 0 : (let ((start 0))
2324 0 : (while (string-match "\\\\" file start)
2325 0 : (aset file (match-beginning 0) ?/)
2326 6 : (setq start (match-end 0))))))
2327 :
2328 : ;; Hence we don't need to worry about converting `\\' back to `\'.
2329 6 : (setq file (read (concat "\"" file "\"")))
2330 : ;; The above `read' will return a unibyte string if FILE
2331 : ;; contains eight-bit-control/graphic characters.
2332 6 : (if (and enable-multibyte-characters
2333 6 : (not (multibyte-string-p file)))
2334 6 : (setq file (string-to-multibyte file)))))
2335 6 : (and file (file-name-absolute-p file)
2336 : ;; A relative file name can start with ~.
2337 : ;; Don't treat it as absolute in this context.
2338 0 : (not (eq (aref file 0) ?~))
2339 6 : (setq already-absolute t))
2340 6 : (cond
2341 6 : ((null file)
2342 : nil)
2343 6 : ((eq localp 'verbatim)
2344 0 : file)
2345 6 : ((and (not no-error-if-not-filep)
2346 6 : (member file '("." "..")))
2347 0 : (error "Cannot operate on `.' or `..'"))
2348 6 : ((and (eq localp 'no-dir) already-absolute)
2349 0 : (file-name-nondirectory file))
2350 6 : (already-absolute
2351 0 : (let ((handler (find-file-name-handler file nil)))
2352 : ;; check for safe-magic property so that we won't
2353 : ;; put /: for names that don't really need them.
2354 : ;; For instance, .gz files when auto-compression-mode is on.
2355 0 : (if (and handler (not (get handler 'safe-magic)))
2356 0 : (concat "/:" file)
2357 0 : file)))
2358 6 : ((eq localp 'no-dir)
2359 0 : file)
2360 6 : ((equal (dired-current-directory) "/")
2361 0 : (setq file (concat (dired-current-directory localp) file))
2362 0 : (let ((handler (find-file-name-handler file nil)))
2363 : ;; check for safe-magic property so that we won't
2364 : ;; put /: for names that don't really need them.
2365 : ;; For instance, .gz files when auto-compression-mode is on.
2366 0 : (if (and handler (not (get handler 'safe-magic)))
2367 0 : (concat "/:" file)
2368 0 : file)))
2369 : (t
2370 6 : (concat (dired-current-directory localp) file)))))
2371 :
2372 : (defun dired-string-replace-match (regexp string newtext
2373 : &optional literal global)
2374 : "Replace first match of REGEXP in STRING with NEWTEXT.
2375 : If it does not match, nil is returned instead of the new string.
2376 : Optional arg LITERAL means to take NEWTEXT literally.
2377 : Optional arg GLOBAL means to replace all matches."
2378 0 : (if global
2379 0 : (let ((start 0) ret)
2380 0 : (while (string-match regexp string start)
2381 0 : (let ((from-end (- (length string) (match-end 0))))
2382 0 : (setq ret (setq string (replace-match newtext t literal string)))
2383 0 : (setq start (- (length string) from-end))))
2384 0 : ret)
2385 0 : (if (not (string-match regexp string 0))
2386 : nil
2387 0 : (replace-match newtext t literal string))))
2388 :
2389 : (defun dired-make-absolute (file &optional dir)
2390 : ;;"Convert FILE (a file name relative to DIR) to an absolute file name."
2391 : ;; We can't always use expand-file-name as this would get rid of `.'
2392 : ;; or expand in / instead default-directory if DIR=="".
2393 : ;; This should be good enough for ange-ftp.
2394 : ;; It should be reasonably fast, though, as it is called in
2395 : ;; dired-get-filename.
2396 0 : (concat (or dir default-directory) file))
2397 :
2398 : (defun dired-make-relative (file &optional dir)
2399 : "Convert FILE (an absolute file name) to a name relative to DIR.
2400 : If DIR is omitted or nil, it defaults to `default-directory'.
2401 : If FILE is not in the directory tree of DIR, return FILE
2402 : unchanged."
2403 0 : (or dir (setq dir default-directory))
2404 : ;; This case comes into play if default-directory is set to
2405 : ;; use ~.
2406 0 : (if (and (> (length dir) 0) (= (aref dir 0) ?~))
2407 0 : (setq dir (expand-file-name dir)))
2408 0 : (if (string-match (concat "^" (regexp-quote dir)) file)
2409 0 : (substring file (match-end 0))
2410 0 : file))
2411 :
2412 : (define-minor-mode dired-hide-details-mode
2413 : "Toggle visibility of detailed information in current Dired buffer.
2414 : When this minor mode is enabled, details such as file ownership and
2415 : permissions are hidden from view.
2416 :
2417 : See options: `dired-hide-details-hide-symlink-targets' and
2418 : `dired-hide-details-hide-information-lines'."
2419 : :group 'dired
2420 0 : (unless (derived-mode-p 'dired-mode)
2421 0 : (error "Not a Dired buffer"))
2422 0 : (dired-hide-details-update-invisibility-spec)
2423 0 : (if dired-hide-details-mode
2424 0 : (add-hook 'wdired-mode-hook
2425 : 'dired-hide-details-update-invisibility-spec
2426 : nil
2427 0 : t)
2428 0 : (remove-hook 'wdired-mode-hook
2429 : 'dired-hide-details-update-invisibility-spec
2430 0 : t)))
2431 :
2432 : (defun dired-hide-details-update-invisibility-spec ()
2433 0 : (funcall (if dired-hide-details-mode
2434 : 'add-to-invisibility-spec
2435 0 : 'remove-from-invisibility-spec)
2436 0 : 'dired-hide-details-detail)
2437 0 : (funcall (if (and dired-hide-details-mode
2438 0 : dired-hide-details-hide-information-lines)
2439 : 'add-to-invisibility-spec
2440 0 : 'remove-from-invisibility-spec)
2441 0 : 'dired-hide-details-information)
2442 0 : (funcall (if (and dired-hide-details-mode
2443 0 : dired-hide-details-hide-symlink-targets
2444 0 : (not (derived-mode-p 'wdired-mode)))
2445 : 'add-to-invisibility-spec
2446 0 : 'remove-from-invisibility-spec)
2447 0 : 'dired-hide-details-link))
2448 :
2449 : ;;; Functions for finding the file name in a dired buffer line.
2450 :
2451 : (defvar dired-permission-flags-regexp
2452 : "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
2453 : "Regular expression to match the permission flags in `ls -l'.")
2454 :
2455 : ;; Move to first char of filename on this line.
2456 : ;; Returns position (point) or nil if no filename on this line."
2457 : (defun dired-move-to-filename (&optional raise-error eol)
2458 : "Move to the beginning of the filename on the current line.
2459 : Return the position of the beginning of the filename, or nil if none found."
2460 : ;; This is the UNIX version.
2461 224 : (or eol (setq eol (line-end-position)))
2462 224 : (beginning-of-line)
2463 : ;; First try assuming `ls --dired' was used.
2464 224 : (let ((change (next-single-property-change (point) 'dired-filename nil eol)))
2465 224 : (cond
2466 224 : ((and change (< change eol))
2467 12 : (goto-char change))
2468 212 : ((re-search-forward directory-listing-before-filename-regexp eol t)
2469 194 : (goto-char (match-end 0)))
2470 18 : ((re-search-forward dired-permission-flags-regexp eol t)
2471 : ;; Ha! There *is* a file. Our regexp-from-hell just failed to find it.
2472 0 : (if raise-error
2473 0 : (error "Unrecognized line! Check directory-listing-before-filename-regexp"))
2474 0 : (beginning-of-line)
2475 : nil)
2476 18 : (raise-error
2477 224 : (error "No file on this line")))))
2478 :
2479 : (defun dired-move-to-end-of-filename (&optional no-error)
2480 : ;; Assumes point is at beginning of filename,
2481 : ;; thus the rwx bit re-search-backward below will succeed in *this*
2482 : ;; line if at all. So, it should be called only after
2483 : ;; (dired-move-to-filename t).
2484 : ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
2485 : ;; This is the UNIX version.
2486 200 : (if (get-text-property (point) 'dired-filename)
2487 6 : (goto-char (next-single-property-change (point) 'dired-filename))
2488 194 : (let (opoint file-type executable symlink hidden used-F eol)
2489 194 : (setq used-F (dired-check-switches dired-actual-switches "F" "classify")
2490 194 : opoint (point)
2491 194 : eol (line-end-position)
2492 194 : hidden (and selective-display
2493 194 : (save-excursion (search-forward "\r" eol t))))
2494 194 : (if hidden
2495 : nil
2496 194 : (save-excursion ;; Find out what kind of file this is:
2497 : ;; Restrict perm bits to be non-blank,
2498 : ;; otherwise this matches one char to early (looking backward):
2499 : ;; "l---------" (some systems make symlinks that way)
2500 : ;; "----------" (plain file with zero perms)
2501 194 : (if (re-search-backward
2502 194 : dired-permission-flags-regexp nil t)
2503 194 : (setq file-type (char-after (match-beginning 1))
2504 194 : symlink (eq file-type ?l)
2505 : ;; Only with -F we need to know whether it's an executable
2506 194 : executable (and
2507 194 : used-F
2508 0 : (string-match
2509 : "[xst]" ;; execute bit set anywhere?
2510 0 : (concat
2511 0 : (match-string 2)
2512 0 : (match-string 3)
2513 194 : (match-string 4)))))
2514 194 : (or no-error (error "No file on this line"))))
2515 : ;; Move point to end of name:
2516 194 : (if symlink
2517 0 : (if (search-forward " -> " eol t)
2518 0 : (progn
2519 0 : (forward-char -4)
2520 0 : (and used-F
2521 0 : dired-ls-F-marks-symlinks
2522 0 : (eq (preceding-char) ?@) ;; did ls really mark the link?
2523 0 : (forward-char -1))))
2524 194 : (goto-char eol) ;; else not a symbolic link
2525 : ;; ls -lF marks dirs, sockets, fifos and executables with exactly
2526 : ;; one trailing character. (Executable bits on symlinks ain't mean
2527 : ;; a thing, even to ls, but we know it's not a symlink.)
2528 194 : (and used-F
2529 0 : (or (memq file-type '(?d ?s ?p))
2530 0 : executable)
2531 194 : (forward-char -1))))
2532 194 : (or no-error
2533 194 : (not (eq opoint (point)))
2534 0 : (error "%s" (if hidden
2535 0 : (substitute-command-keys
2536 0 : "File line is hidden, type \\[dired-hide-subdir] to unhide")
2537 194 : "No file on this line")))
2538 194 : (if (eq opoint (point))
2539 : nil
2540 200 : (point)))))
2541 :
2542 :
2543 : ;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
2544 :
2545 : (defun dired-copy-filename-as-kill (&optional arg)
2546 : "Copy names of marked (or next ARG) files into the kill ring.
2547 : The names are separated by a space.
2548 : With a zero prefix arg, use the absolute file name of each marked file.
2549 : With \\[universal-argument], use the file name relative to the Dired buffer's
2550 : `default-directory'. (This still may contain slashes if in a subdirectory.)
2551 :
2552 : If on a subdir headerline, use absolute subdirname instead;
2553 : prefix arg and marked files are ignored in this case.
2554 :
2555 : You can then feed the file name(s) to other commands with \\[yank]."
2556 : (interactive "P")
2557 0 : (let ((string
2558 0 : (or (dired-get-subdir)
2559 0 : (mapconcat #'identity
2560 0 : (if arg
2561 0 : (cond ((zerop (prefix-numeric-value arg))
2562 0 : (dired-get-marked-files))
2563 0 : ((consp arg)
2564 0 : (dired-get-marked-files t))
2565 : (t
2566 0 : (dired-get-marked-files
2567 0 : 'no-dir (prefix-numeric-value arg))))
2568 0 : (dired-get-marked-files 'no-dir))
2569 0 : " "))))
2570 0 : (unless (string= string "")
2571 0 : (if (eq last-command 'kill-region)
2572 0 : (kill-append string nil)
2573 0 : (kill-new string))
2574 0 : (message "%s" string))))
2575 :
2576 :
2577 : ;; Keeping Dired buffers in sync with the filesystem and with each other
2578 :
2579 : (defun dired-buffers-for-dir (dir &optional file)
2580 : ;; Return a list of buffers for DIR (top level or in-situ subdir).
2581 : ;; If FILE is non-nil, include only those whose wildcard pattern (if any)
2582 : ;; matches FILE.
2583 : ;; The list is in reverse order of buffer creation, most recent last.
2584 : ;; As a side effect, killed dired buffers for DIR are removed from
2585 : ;; dired-buffers.
2586 6 : (setq dir (file-name-as-directory dir))
2587 6 : (let (result buf)
2588 6 : (dolist (elt dired-buffers)
2589 5 : (setq buf (cdr elt))
2590 5 : (cond
2591 5 : ((null (buffer-name buf))
2592 : ;; Buffer is killed - clean up:
2593 5 : (setq dired-buffers (delq elt dired-buffers)))
2594 0 : ((dired-in-this-tree dir (car elt))
2595 0 : (with-current-buffer buf
2596 0 : (and (assoc dir dired-subdir-alist)
2597 0 : (or (null file)
2598 0 : (if (stringp dired-directory)
2599 0 : (let ((wildcards (file-name-nondirectory
2600 0 : dired-directory)))
2601 0 : (or (zerop (length wildcards))
2602 0 : (string-match-p (dired-glob-regexp wildcards)
2603 0 : file)))
2604 0 : (member (expand-file-name file dir)
2605 0 : (cdr dired-directory))))
2606 6 : (setq result (cons buf result)))))))
2607 6 : result))
2608 :
2609 : (defun dired-glob-regexp (pattern)
2610 : "Convert glob-pattern PATTERN to a regular expression."
2611 0 : (let ((matched-in-pattern 0) ;; How many chars of PATTERN we've handled.
2612 : regexp)
2613 0 : (while (string-match "[[?*]" pattern matched-in-pattern)
2614 0 : (let ((op-end (match-end 0))
2615 0 : (next-op (aref pattern (match-beginning 0))))
2616 0 : (setq regexp (concat regexp
2617 0 : (regexp-quote
2618 0 : (substring pattern matched-in-pattern
2619 0 : (match-beginning 0)))))
2620 0 : (cond ((= next-op ??)
2621 0 : (setq regexp (concat regexp "."))
2622 0 : (setq matched-in-pattern op-end))
2623 0 : ((= next-op ?\[)
2624 : ;; Fails to handle ^ yet ????
2625 0 : (let* ((set-start (match-beginning 0))
2626 : (set-cont
2627 0 : (if (= (aref pattern (1+ set-start)) ?^)
2628 0 : (+ 3 set-start)
2629 0 : (+ 2 set-start)))
2630 0 : (set-end (string-match-p "]" pattern set-cont))
2631 0 : (set (substring pattern set-start (1+ set-end))))
2632 0 : (setq regexp (concat regexp set))
2633 0 : (setq matched-in-pattern (1+ set-end))))
2634 0 : ((= next-op ?*)
2635 0 : (setq regexp (concat regexp ".*"))
2636 0 : (setq matched-in-pattern op-end)))))
2637 0 : (concat "\\`"
2638 0 : regexp
2639 0 : (regexp-quote
2640 0 : (substring pattern matched-in-pattern))
2641 0 : "\\'")))
2642 :
2643 :
2644 :
2645 : (defun dired-advertise ()
2646 : ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
2647 : ;; With wildcards we actually advertise too much.
2648 6 : (let ((expanded-default (expand-file-name default-directory)))
2649 6 : (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
2650 : t ; we have already advertised ourselves
2651 6 : (setq dired-buffers
2652 6 : (cons (cons expanded-default (current-buffer))
2653 6 : dired-buffers)))))
2654 :
2655 : (defun dired-unadvertise (dir)
2656 : ;; Remove DIR from the buffer alist in variable dired-buffers.
2657 : ;; This has the effect of removing any buffer whose main directory is DIR.
2658 : ;; It does not affect buffers in which DIR is a subdir.
2659 : ;; Removing is also done as a side-effect in dired-buffer-for-dir.
2660 0 : (setq dired-buffers
2661 0 : (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
2662 :
2663 : ;; Tree Dired
2664 :
2665 : ;;; utility functions
2666 :
2667 : (defun dired-in-this-tree (file dir)
2668 : ;;"Is FILE part of the directory tree starting at DIR?"
2669 0 : (let (case-fold-search)
2670 0 : (string-match-p (concat "^" (regexp-quote dir)) file)))
2671 :
2672 : (defun dired-normalize-subdir (dir)
2673 : ;; Prepend default-directory to DIR if relative file name.
2674 : ;; dired-get-filename must be able to make a valid file name from a
2675 : ;; file and its directory DIR.
2676 6 : (file-name-as-directory
2677 6 : (if (file-name-absolute-p dir)
2678 6 : dir
2679 6 : (expand-file-name dir default-directory))))
2680 :
2681 : (defun dired-get-subdir ()
2682 : ;;"Return the subdir name on this line, or nil if not on a headerline."
2683 : ;; Look up in the alist whether this is a headerline.
2684 0 : (save-excursion
2685 0 : (let ((cur-dir (dired-current-directory)))
2686 0 : (beginning-of-line) ; alist stores b-o-l positions
2687 0 : (and (zerop (- (point)
2688 0 : (dired-get-subdir-min (assoc cur-dir
2689 0 : dired-subdir-alist))))
2690 0 : cur-dir))))
2691 :
2692 : ;; can't use macro, must be redefinable for other alist format in dired-nstd.
2693 : (defalias 'dired-get-subdir-min 'cdr)
2694 :
2695 : (defun dired-get-subdir-max (elt)
2696 0 : (save-excursion
2697 0 : (goto-char (dired-get-subdir-min elt))
2698 0 : (dired-subdir-max)))
2699 :
2700 : (defun dired-clear-alist ()
2701 6 : (while dired-subdir-alist
2702 0 : (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
2703 6 : (setq dired-subdir-alist (cdr dired-subdir-alist))))
2704 :
2705 : (defun dired-subdir-index (dir)
2706 : ;; Return an index into alist for use with nth
2707 : ;; for the sake of subdir moving commands.
2708 0 : (let (found (index 0) (alist dired-subdir-alist))
2709 0 : (while alist
2710 0 : (if (string= dir (car (car alist)))
2711 0 : (setq alist nil found t)
2712 0 : (setq alist (cdr alist) index (1+ index))))
2713 0 : (if found index nil)))
2714 :
2715 : (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
2716 : "Go to next subdirectory, regardless of level."
2717 : ;; Use 0 arg to go to this directory's header line.
2718 : ;; NO-SKIP prevents moving to end of header line, returning whatever
2719 : ;; position was found in dired-subdir-alist.
2720 : (interactive "p")
2721 0 : (let ((this-dir (dired-current-directory))
2722 : pos index)
2723 : ;; nth with negative arg does not return nil but the first element
2724 0 : (setq index (- (dired-subdir-index this-dir) arg))
2725 0 : (setq pos (if (>= index 0)
2726 0 : (dired-get-subdir-min (nth index dired-subdir-alist))))
2727 0 : (if pos
2728 0 : (progn
2729 0 : (goto-char pos)
2730 0 : (or no-skip (skip-chars-forward "^\n\r"))
2731 0 : (point))
2732 0 : (if no-error-if-not-found
2733 : nil ; return nil if not found
2734 0 : (error "%s directory" (if (> arg 0) "Last" "First"))))))
2735 :
2736 : (defun dired-build-subdir-alist (&optional switches)
2737 : "Build `dired-subdir-alist' by parsing the buffer.
2738 : Returns the new value of the alist.
2739 : If optional arg SWITCHES is non-nil, use its value
2740 : instead of `dired-actual-switches'."
2741 : (interactive)
2742 6 : (dired-clear-alist)
2743 6 : (save-excursion
2744 6 : (let* ((count 0)
2745 : (inhibit-read-only t)
2746 : (buffer-undo-list t)
2747 6 : (switches (or switches dired-actual-switches))
2748 : new-dir-name
2749 : (R-ftp-base-dir-regex
2750 : ;; Used to expand subdirectory names correctly in recursive
2751 : ;; ange-ftp listings.
2752 6 : (and (dired-switches-recursive-p switches)
2753 0 : (string-match "\\`/.*:\\(/.*\\)" default-directory)
2754 6 : (concat "\\`" (match-string 1 default-directory)))))
2755 6 : (goto-char (point-min))
2756 6 : (setq dired-subdir-alist nil)
2757 12 : (while (re-search-forward dired-subdir-regexp nil t)
2758 : ;; Avoid taking a file name ending in a colon
2759 : ;; as a subdir name.
2760 6 : (unless (save-excursion
2761 6 : (goto-char (match-beginning 0))
2762 6 : (beginning-of-line)
2763 6 : (forward-char 2)
2764 6 : (looking-at-p dired-re-perms))
2765 6 : (save-excursion
2766 6 : (goto-char (match-beginning 1))
2767 6 : (setq new-dir-name
2768 6 : (buffer-substring-no-properties (point) (match-end 1))
2769 : new-dir-name
2770 6 : (save-match-data
2771 6 : (if (and R-ftp-base-dir-regex
2772 0 : (not (string= new-dir-name default-directory))
2773 6 : (string-match R-ftp-base-dir-regex new-dir-name))
2774 0 : (concat default-directory
2775 0 : (substring new-dir-name (match-end 0)))
2776 6 : (expand-file-name new-dir-name))))
2777 6 : (delete-region (point) (match-end 1))
2778 6 : (insert new-dir-name))
2779 6 : (setq count (1+ count))
2780 : ;; Undo any escaping of newlines and \ by dired-insert-directory.
2781 : ;; Convert "n" preceded by odd number of \ to newline, and \\ to \.
2782 6 : (when (and (dired-switches-escape-p switches)
2783 6 : (string-match-p "\\\\" new-dir-name))
2784 0 : (let (temp res)
2785 0 : (mapc (lambda (char)
2786 0 : (cond ((equal char ?\\)
2787 0 : (if temp
2788 0 : (setq res (concat res "\\")
2789 0 : temp nil)
2790 0 : (setq temp "\\")))
2791 0 : ((and temp (equal char ?n))
2792 0 : (setq res (concat res "\n")
2793 0 : temp nil))
2794 : (t
2795 0 : (setq res (concat res temp (char-to-string char))
2796 0 : temp nil))))
2797 0 : new-dir-name)
2798 6 : (setq new-dir-name res)))
2799 6 : (dired-alist-add-1 new-dir-name
2800 : ;; Place a sub directory boundary between lines.
2801 6 : (save-excursion
2802 6 : (goto-char (match-beginning 0))
2803 6 : (beginning-of-line)
2804 6 : (point-marker)))))
2805 6 : (if (and (> count 1) (called-interactively-p 'interactive))
2806 6 : (message "Buffer includes %d directories" count)))
2807 : ;; We don't need to sort it because it is in buffer order per
2808 : ;; constructionem. Return new alist:
2809 6 : dired-subdir-alist))
2810 :
2811 : (defun dired-alist-add-1 (dir new-marker)
2812 : ;; Add new DIR at NEW-MARKER. Don't sort.
2813 6 : (setq dired-subdir-alist
2814 6 : (cons (cons (dired-normalize-subdir dir) new-marker)
2815 6 : dired-subdir-alist)))
2816 :
2817 : (defun dired-goto-next-nontrivial-file ()
2818 : ;; Position point on first nontrivial file after point.
2819 6 : (dired-goto-next-file);; so there is a file to compare with
2820 6 : (if (stringp dired-trivial-filenames)
2821 6 : (while (and (not (eobp))
2822 6 : (string-match-p dired-trivial-filenames
2823 6 : (file-name-nondirectory
2824 6 : (or (dired-get-filename nil t) ""))))
2825 0 : (forward-line 1)
2826 6 : (dired-move-to-filename))))
2827 :
2828 : (defun dired-goto-next-file ()
2829 6 : (let ((max (1- (dired-subdir-max))))
2830 18 : (while (and (not (dired-move-to-filename)) (< (point) max))
2831 12 : (forward-line 1))))
2832 :
2833 : (defun dired-goto-file (file)
2834 : "Go to line describing file FILE in this Dired buffer."
2835 : ;; Return value of point on success, else nil.
2836 : ;; FILE must be an absolute file name.
2837 : ;; Loses if FILE contains control chars like "\007" for which ls
2838 : ;; either inserts "?" or "\\007" into the buffer, so we won't find
2839 : ;; it in the buffer.
2840 : (interactive
2841 0 : (prog1 ; let push-mark display its message
2842 0 : (list (expand-file-name
2843 0 : (read-file-name "Goto file: "
2844 0 : (dired-current-directory))))
2845 0 : (push-mark)))
2846 0 : (unless (file-name-absolute-p file)
2847 0 : (error "File name `%s' is not absolute" file))
2848 0 : (setq file (directory-file-name file)) ; does no harm if not a directory
2849 0 : (let* ((case-fold-search nil)
2850 0 : (dir (file-name-directory file))
2851 0 : (found (or
2852 : ;; First, look for a listing under the absolute name.
2853 0 : (save-excursion
2854 0 : (goto-char (point-min))
2855 0 : (dired-goto-file-1 file file (point-max)))
2856 : ;; Next, look for it as a relative name with leading
2857 : ;; subdirectories. (This happens in Dired buffers
2858 : ;; created by find-dired, for example.)
2859 0 : (save-excursion
2860 0 : (goto-char (point-min))
2861 0 : (dired-goto-file-1 (file-relative-name file
2862 0 : default-directory)
2863 0 : file (point-max)))
2864 : ;; Otherwise, look for it as a relative name, a base
2865 : ;; name only. The hair is to get the result of
2866 : ;; `dired-goto-subdir' without calling it if we don't
2867 : ;; have any subdirs.
2868 0 : (save-excursion
2869 0 : (when (if (string= dir (expand-file-name default-directory))
2870 0 : (goto-char (point-min))
2871 0 : (and (cdr dired-subdir-alist)
2872 0 : (dired-goto-subdir dir)))
2873 0 : (dired-goto-file-1 (file-name-nondirectory file)
2874 0 : file
2875 0 : (dired-subdir-max)))))))
2876 : ;; Return buffer position, if found.
2877 0 : (if found
2878 0 : (goto-char found))))
2879 :
2880 : (defun dired-goto-file-1 (file full-name limit)
2881 : "Advance to the Dired listing labeled by FILE; return its position.
2882 : Return nil if the listing is not found. If FILE contains
2883 : characters that would not appear in a Dired buffer, search using
2884 : the quoted forms of those characters.
2885 :
2886 : FULL-NAME specifies the actual file name the listing must have,
2887 : as returned by `dired-get-filename'. LIMIT is the search limit."
2888 0 : (let (str)
2889 0 : (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t))
2890 0 : (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
2891 0 : (and (dired-switches-escape-p dired-actual-switches)
2892 0 : (string-match-p "[ \t\n]" str)
2893 : ;; FIXME: to fix this for embedded control characters etc, we
2894 : ;; should escape everything that `ls -b' does.
2895 0 : (setq str (replace-regexp-in-string " " "\\ " str nil t)
2896 0 : str (replace-regexp-in-string "\t" "\\t" str nil t)
2897 0 : str (replace-regexp-in-string "\n" "\\n" str nil t)))
2898 0 : (let ((found nil)
2899 : ;; filenames are preceded by SPC, this makes the search faster
2900 : ;; (e.g. for the filename "-").
2901 0 : (search-string (concat " " str)))
2902 0 : (while (and (not found)
2903 0 : (search-forward search-string limit 'move))
2904 : ;; Check that we are in the right place. Match could have
2905 : ;; BASE just as initial substring or in permission bits etc.
2906 0 : (if (equal full-name (dired-get-filename nil t))
2907 0 : (setq found (dired-move-to-filename))
2908 0 : (forward-line 1)))
2909 0 : found)))
2910 :
2911 : (defvar dired-find-subdir)
2912 :
2913 : ;; FIXME document whatever dired-x is doing.
2914 : (defun dired-initial-position (dirname)
2915 : "Where point should go in a new listing of DIRNAME.
2916 : Point is assumed to be at the beginning of new subdir line.
2917 : It runs the hook `dired-initial-position-hook'."
2918 6 : (end-of-line)
2919 6 : (and (featurep 'dired-x) dired-find-subdir
2920 6 : (dired-goto-subdir dirname))
2921 6 : (if dired-trivial-filenames (dired-goto-next-nontrivial-file))
2922 6 : (run-hooks 'dired-initial-position-hook))
2923 :
2924 : ;; These are hooks which make tree dired work.
2925 : ;; They are in this file because other parts of dired need to call them.
2926 : ;; But they don't call the rest of tree dired unless there are subdirs loaded.
2927 :
2928 : ;; This function is called for each retrieved filename.
2929 : ;; It could stand to be faster, though it's mostly function call
2930 : ;; overhead. Avoiding the function call seems to save about 10% in
2931 : ;; dired-get-filename. Make it a defsubst?
2932 : (defun dired-current-directory (&optional localp)
2933 : "Return the name of the subdirectory to which this line belongs.
2934 : This returns a string with trailing slash, like `default-directory'.
2935 : Optional argument means return a file name relative to `default-directory',
2936 : in which case the value could be an empty string if `default-directory'
2937 : is the directory where the file on this line resides."
2938 12 : (let ((here (point))
2939 12 : (alist (or dired-subdir-alist
2940 : ;; probably because called in a non-dired buffer
2941 12 : (error "No subdir-alist in %s" (current-buffer))))
2942 : elt dir)
2943 24 : (while alist
2944 12 : (setq elt (car alist)
2945 12 : dir (car elt)
2946 : ;; use `<=' (not `<') as subdir line is part of subdir
2947 12 : alist (if (<= (dired-get-subdir-min elt) here)
2948 : nil ; found
2949 12 : (cdr alist))))
2950 12 : (if localp
2951 0 : (dired-make-relative dir default-directory)
2952 12 : dir)))
2953 :
2954 : ;; Subdirs start at the beginning of their header lines and end just
2955 : ;; before the beginning of the next header line (or end of buffer).
2956 :
2957 : (defun dired-subdir-max ()
2958 6 : (save-excursion
2959 6 : (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
2960 6 : (point-max)
2961 6 : (point))))
2962 :
2963 : ;; Deleting files
2964 :
2965 : (defcustom dired-recursive-deletes 'top
2966 : "Whether Dired deletes directories recursively.
2967 : If nil, Dired will not delete non-empty directories.
2968 : `always' means to delete non-empty directories recursively,
2969 : without asking. This is dangerous!
2970 : `top' means to ask for each top-level directory specified by the
2971 : Dired deletion command, and delete its subdirectories without
2972 : asking.
2973 : Any other value means to ask for each directory."
2974 : :type '(choice :tag "Delete non-empty directories"
2975 : (const :tag "Yes" always)
2976 : (const :tag "No--only delete empty directories" nil)
2977 : (const :tag "Confirm for each directory" t)
2978 : (const :tag "Confirm for each top directory only" top))
2979 : :group 'dired)
2980 :
2981 : ;; Match anything but `.' and `..'.
2982 : (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
2983 :
2984 : (defconst dired-delete-help
2985 : "Type:
2986 : `yes' to delete recursively the current directory,
2987 : `no' to skip to next,
2988 : `all' to delete all remaining directories with no more questions,
2989 : `quit' to exit,
2990 : `help' to show this help message.")
2991 :
2992 : (defun dired--yes-no-all-quit-help (prompt &optional help-msg)
2993 : "Ask a question with valid answers: yes, no, all, quit, help.
2994 : PROMPT must end with '? ', for instance, 'Delete it? '.
2995 : If optional arg HELP-MSG is non-nil, then is a message to show when
2996 : the user answers 'help'. Otherwise, default to `dired-delete-help'."
2997 0 : (let ((valid-answers (list "yes" "no" "all" "quit"))
2998 : (answer "")
2999 : (input-fn (lambda ()
3000 0 : (read-string
3001 0 : (format "%s [yes, no, all, quit, help] " prompt)))))
3002 0 : (setq answer (funcall input-fn))
3003 0 : (when (string= answer "help")
3004 0 : (with-help-window "*Help*"
3005 0 : (with-current-buffer "*Help*"
3006 0 : (insert (or help-msg dired-delete-help)))))
3007 0 : (while (not (member answer valid-answers))
3008 0 : (unless (string= answer "help")
3009 0 : (beep)
3010 0 : (message "Please answer `yes' or `no' or `all' or `quit'")
3011 0 : (sleep-for 2))
3012 0 : (setq answer (funcall input-fn)))
3013 0 : answer))
3014 :
3015 : ;; Delete file, possibly delete a directory and all its files.
3016 : ;; This function is useful outside of dired. One could change its name
3017 : ;; to e.g. recursive-delete-file and put it somewhere else.
3018 : (defun dired-delete-file (file &optional recursive trash) "\
3019 : Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
3020 : RECURSIVE determines what to do with a non-empty directory. The effect of
3021 : its possible values is:
3022 :
3023 : nil -- do not delete.
3024 : `always' -- delete recursively without asking.
3025 : `top' -- ask for each directory at top level.
3026 : Anything else -- ask for each sub-directory.
3027 :
3028 : TRASH non-nil means to trash the file instead of deleting, provided
3029 : `delete-by-moving-to-trash' (which see) is non-nil."
3030 : ;; This test is equivalent to
3031 : ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
3032 : ;; but more efficient
3033 0 : (if (not (eq t (car (file-attributes file))))
3034 0 : (delete-file file trash)
3035 0 : (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
3036 0 : (if (and recursive (not empty-dir-p))
3037 0 : (unless (eq recursive 'always)
3038 0 : (let ((prompt
3039 0 : (format "Recursively %s %s? "
3040 0 : (if (and trash delete-by-moving-to-trash)
3041 : "trash"
3042 0 : "delete")
3043 0 : (dired-make-relative file))))
3044 0 : (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
3045 0 : ('"all" (setq recursive 'always dired-recursive-deletes recursive))
3046 0 : ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
3047 0 : ('"no" (setq recursive nil))
3048 0 : ('"quit" (keyboard-quit)))))
3049 0 : (setq recursive nil)) ; Empty dir or recursive is nil.
3050 0 : (delete-directory file recursive trash))))
3051 :
3052 : (defun dired-do-flagged-delete (&optional nomessage)
3053 : "In Dired, delete the files flagged for deletion.
3054 : If NOMESSAGE is non-nil, we don't display any message
3055 : if there are no flagged files.
3056 : `dired-recursive-deletes' controls whether deletion of
3057 : non-empty directories is allowed."
3058 : (interactive)
3059 0 : (let* ((dired-marker-char dired-del-marker)
3060 0 : (regexp (dired-marker-regexp))
3061 : case-fold-search)
3062 0 : (if (save-excursion (goto-char (point-min))
3063 0 : (re-search-forward regexp nil t))
3064 0 : (dired-internal-do-deletions
3065 0 : (nreverse
3066 : ;; this can't move point since ARG is nil
3067 0 : (dired-map-over-marks (cons (dired-get-filename) (point))
3068 0 : nil))
3069 0 : nil t)
3070 0 : (or nomessage
3071 0 : (message "(No deletions requested)")))))
3072 :
3073 : (defun dired-do-delete (&optional arg)
3074 : "Delete all marked (or next ARG) files.
3075 : `dired-recursive-deletes' controls whether deletion of
3076 : non-empty directories is allowed."
3077 : ;; This is more consistent with the file marking feature than
3078 : ;; dired-do-flagged-delete.
3079 : (interactive "P")
3080 0 : (dired-internal-do-deletions
3081 0 : (nreverse
3082 : ;; this may move point if ARG is an integer
3083 0 : (dired-map-over-marks (cons (dired-get-filename) (point))
3084 0 : arg))
3085 0 : arg t))
3086 :
3087 : (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
3088 :
3089 : (defun dired-internal-do-deletions (l arg &optional trash)
3090 : ;; L is an alist of files to delete, with their buffer positions.
3091 : ;; ARG is the prefix arg.
3092 : ;; Filenames are absolute.
3093 : ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
3094 : ;; That way as changes are made in the buffer they do not shift the
3095 : ;; lines still to be changed, so the (point) values in L stay valid.
3096 : ;; Also, for subdirs in natural order, a subdir's files are deleted
3097 : ;; before the subdir itself - the other way around would not work.
3098 0 : (let* ((files (mapcar #'car l))
3099 0 : (count (length l))
3100 : (succ 0)
3101 : ;; Bind `dired-recursive-deletes' so that we can change it
3102 : ;; locally according with the user answer within `dired-delete-file'.
3103 0 : (dired-recursive-deletes dired-recursive-deletes)
3104 0 : (trashing (and trash delete-by-moving-to-trash)))
3105 : ;; canonicalize file list for pop up
3106 0 : (setq files (nreverse (mapcar #'dired-make-relative files)))
3107 0 : (if (dired-mark-pop-up
3108 0 : " *Deletions*" 'delete files dired-deletion-confirmer
3109 0 : (format "%s %s "
3110 0 : (if trashing "Trash" "Delete")
3111 0 : (dired-mark-prompt arg files)))
3112 0 : (save-excursion
3113 0 : (catch '--delete-cancel
3114 0 : (let ((progress-reporter
3115 0 : (make-progress-reporter
3116 0 : (if trashing "Trashing..." "Deleting...")
3117 0 : succ count))
3118 : failures) ;; files better be in reverse order for this loop!
3119 0 : (while l
3120 0 : (goto-char (cdr (car l)))
3121 0 : (let ((inhibit-read-only t))
3122 0 : (condition-case err
3123 0 : (let ((fn (car (car l))))
3124 0 : (dired-delete-file fn dired-recursive-deletes trash)
3125 : ;; if we get here, removing worked
3126 0 : (setq succ (1+ succ))
3127 0 : (progress-reporter-update progress-reporter succ)
3128 0 : (dired-fun-in-all-buffers
3129 0 : (file-name-directory fn) (file-name-nondirectory fn)
3130 0 : #'dired-delete-entry fn))
3131 0 : (quit (throw '--delete-cancel (message "OK, canceled")))
3132 : (error ;; catch errors from failed deletions
3133 0 : (dired-log "%s\n" err)
3134 0 : (setq failures (cons (car (car l)) failures)))))
3135 0 : (setq l (cdr l)))
3136 0 : (if (not failures)
3137 0 : (progress-reporter-done progress-reporter)
3138 0 : (dired-log-summary
3139 0 : (format "%d of %d deletion%s failed"
3140 0 : (length failures) count
3141 0 : (dired-plural-s count))
3142 0 : failures)))))
3143 0 : (message "(No deletions performed)")))
3144 0 : (dired-move-to-filename))
3145 :
3146 : (defun dired-fun-in-all-buffers (directory file fun &rest args)
3147 : ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
3148 : ;; If the buffer has a wildcard pattern, check that it matches FILE.
3149 : ;; (FILE does not include a directory component.)
3150 : ;; FILE may be nil, in which case ignore it.
3151 : ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
3152 0 : (let (success-list)
3153 0 : (dolist (buf (dired-buffers-for-dir (expand-file-name directory)
3154 0 : file))
3155 0 : (with-current-buffer buf
3156 0 : (if (apply fun args)
3157 0 : (setq success-list (cons (buffer-name buf) success-list)))))
3158 0 : success-list))
3159 :
3160 : ;; Delete the entry for FILE from
3161 : (defun dired-delete-entry (file)
3162 0 : (save-excursion
3163 0 : (and (dired-goto-file file)
3164 0 : (let ((inhibit-read-only t))
3165 0 : (delete-region (progn (beginning-of-line) (point))
3166 0 : (save-excursion (forward-line 1) (point))))))
3167 0 : (dired-clean-up-after-deletion file))
3168 :
3169 : (defvar dired-clean-up-buffers-too)
3170 :
3171 : (defun dired-clean-up-after-deletion (fn)
3172 : "Clean up after a deleted file or directory FN.
3173 : Removes any expanded subdirectory of deleted directory.
3174 : If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil,
3175 : also offers to kill buffers visiting deleted files and directories."
3176 0 : (save-excursion (and (cdr dired-subdir-alist)
3177 0 : (dired-goto-subdir fn)
3178 0 : (dired-kill-subdir)))
3179 : ;; Offer to kill buffer of deleted file FN.
3180 0 : (when (and (featurep 'dired-x) dired-clean-up-buffers-too)
3181 0 : (let ((buf (get-file-buffer fn)))
3182 0 : (and buf
3183 0 : (funcall #'y-or-n-p
3184 0 : (format "Kill buffer of %s, too? "
3185 0 : (file-name-nondirectory fn)))
3186 0 : (kill-buffer buf)))
3187 0 : (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
3188 0 : (and buf-list
3189 0 : (y-or-n-p (format "Kill Dired buffer%s of %s, too? "
3190 0 : (dired-plural-s (length buf-list))
3191 0 : (file-name-nondirectory fn)))
3192 0 : (dolist (buf buf-list)
3193 0 : (kill-buffer buf))))))
3194 :
3195 :
3196 : ;; Confirmation
3197 :
3198 : (defun dired-marker-regexp ()
3199 0 : (concat "^" (regexp-quote (char-to-string dired-marker-char))))
3200 :
3201 : (defun dired-plural-s (count)
3202 0 : (if (= 1 count) "" "s"))
3203 :
3204 : (defun dired-mark-prompt (arg files)
3205 : "Return a string suitable for use in a Dired prompt.
3206 : ARG is normally the prefix argument for the calling command.
3207 : FILES should be a list of file names.
3208 :
3209 : The return value has a form like \"foo.txt\", \"[next 3 files]\",
3210 : or \"* [3 files]\"."
3211 : ;; distinguish-one-marked can cause the first element to be just t.
3212 0 : (if (eq (car files) t) (setq files (cdr files)))
3213 0 : (let ((count (length files)))
3214 0 : (if (= count 1)
3215 0 : (car files)
3216 : ;; more than 1 file:
3217 0 : (if (integerp arg)
3218 : ;; abs(arg) = count
3219 : ;; Perhaps this is nicer, but it also takes more screen space:
3220 : ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
3221 : ;; count)
3222 0 : (format "[next %d files]" arg)
3223 0 : (format "%c [%d files]" dired-marker-char count)))))
3224 :
3225 : (defun dired-pop-to-buffer (buf)
3226 : "Pop up buffer BUF in a way suitable for Dired."
3227 : (declare (obsolete dired-mark-pop-up "24.3"))
3228 0 : (let ((split-window-preferred-function
3229 : (lambda (window)
3230 0 : (or (and (let ((split-height-threshold 0))
3231 0 : (window-splittable-p (selected-window)))
3232 : ;; Try to split the selected window vertically if
3233 : ;; that's possible. (Bug#1806)
3234 0 : (split-window-below))
3235 : ;; Otherwise, try to split WINDOW sensibly.
3236 0 : (split-window-sensibly window))))
3237 : pop-up-frames)
3238 0 : (pop-to-buffer (get-buffer-create buf)))
3239 : ;; See Bug#12281.
3240 0 : (set-window-start nil (point-min))
3241 : ;; If dired-shrink-to-fit is t, make its window fit its contents.
3242 0 : (when dired-shrink-to-fit
3243 : ;; Try to not delete window when we want to display less than
3244 : ;; `window-min-height' lines.
3245 0 : (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t)))
3246 :
3247 : (defcustom dired-no-confirm nil
3248 : "A list of symbols for commands Dired should not confirm, or t.
3249 : Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
3250 : `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink',
3251 : `touch' and `uncompress'.
3252 : If t, confirmation is never needed."
3253 : :group 'dired
3254 : :type '(choice (const :tag "Confirmation never needed" t)
3255 : (set (const byte-compile) (const chgrp)
3256 : (const chmod) (const chown) (const compress)
3257 : (const copy) (const delete) (const hardlink)
3258 : (const load) (const move) (const print)
3259 : (const shell) (const symlink) (const touch)
3260 : (const uncompress))))
3261 :
3262 : (defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
3263 : "Return FUNCTION's result on ARGS after showing which files are marked.
3264 : Displays the file names in a window showing a buffer named
3265 : BUFFER-OR-NAME; the default name being \" *Marked Files*\". The
3266 : window is not shown if there is just one file, `dired-no-confirm'
3267 : is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
3268 :
3269 : By default, Dired shrinks the display buffer to fit the marked files.
3270 : To disable this, use the Customization interface to add a new rule
3271 : to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
3272 : action argument symbol is `window-height' and its value is nil.
3273 :
3274 : FILES is the list of marked files. It can also be (t FILENAME)
3275 : in the case of one marked file, to distinguish that from using
3276 : just the current file.
3277 :
3278 : FUNCTION should not manipulate files, just read input (an
3279 : argument or confirmation)."
3280 0 : (if (or (eq dired-no-confirm t)
3281 0 : (memq op-symbol dired-no-confirm)
3282 : ;; If FILES defaulted to the current line's file.
3283 0 : (= (length files) 1))
3284 0 : (apply function args)
3285 0 : (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*")))
3286 : ;; Mark *Marked Files* window as softly-dedicated, to prevent
3287 : ;; other buffers e.g. *Completions* from reusing it (bug#17554).
3288 : (display-buffer-mark-dedicated 'soft))
3289 0 : (with-displayed-buffer-window
3290 0 : buffer
3291 0 : (cons 'display-buffer-below-selected
3292 : '((window-height . fit-window-to-buffer)
3293 0 : (preserve-size . (nil . t))))
3294 0 : #'(lambda (window _value)
3295 0 : (with-selected-window window
3296 0 : (unwind-protect
3297 0 : (apply function args)
3298 0 : (when (window-live-p window)
3299 0 : (quit-restore-window window 'kill)))))
3300 : ;; Handle (t FILE) just like (FILE), here. That value is
3301 : ;; used (only in some cases), to mean just one file that was
3302 : ;; marked, rather than the current line file.
3303 0 : (with-current-buffer buffer
3304 0 : (dired-format-columns-of-files
3305 0 : (if (eq (car files) t) (cdr files) files))
3306 0 : (remove-text-properties (point-min) (point-max)
3307 0 : '(mouse-face nil help-echo nil)))))))
3308 :
3309 : (defun dired-format-columns-of-files (files)
3310 0 : (let ((beg (point)))
3311 0 : (completion--insert-strings files)
3312 0 : (put-text-property beg (point) 'mouse-face nil)))
3313 :
3314 : ;; Commands to mark or flag file(s) at or near current line.
3315 :
3316 : (defun dired-repeat-over-lines (arg function)
3317 : ;; This version skips non-file lines.
3318 0 : (let ((pos (make-marker)))
3319 0 : (beginning-of-line)
3320 0 : (while (and (> arg 0) (not (eobp)))
3321 0 : (setq arg (1- arg))
3322 0 : (beginning-of-line)
3323 0 : (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
3324 0 : (save-excursion
3325 0 : (forward-line 1)
3326 0 : (move-marker pos (1+ (point))))
3327 0 : (save-excursion (funcall function))
3328 : ;; Advance to the next line--actually, to the line that *was* next.
3329 : ;; (If FUNCTION inserted some new lines in between, skip them.)
3330 0 : (goto-char pos))
3331 0 : (while (and (< arg 0) (not (bobp)))
3332 0 : (setq arg (1+ arg))
3333 0 : (forward-line -1)
3334 0 : (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
3335 0 : (beginning-of-line)
3336 0 : (save-excursion (funcall function)))
3337 0 : (move-marker pos nil)
3338 0 : (dired-move-to-filename)))
3339 :
3340 : (defun dired-between-files ()
3341 : ;; This used to be a regexp match of the `total ...' line output by
3342 : ;; ls, which is slightly faster, but that is not very robust; notably,
3343 : ;; it fails for non-english locales.
3344 0 : (save-excursion (not (dired-move-to-filename))))
3345 :
3346 : (defun dired-next-marked-file (arg &optional wrap opoint)
3347 : "Move to the next marked file.
3348 : If WRAP is non-nil, wrap around to the beginning of the buffer if
3349 : we reach the end."
3350 : (interactive "p\np")
3351 0 : (or opoint (setq opoint (point)));; return to where interactively started
3352 0 : (if (if (> arg 0)
3353 0 : (re-search-forward dired-re-mark nil t arg)
3354 0 : (beginning-of-line)
3355 0 : (re-search-backward dired-re-mark nil t (- arg)))
3356 0 : (dired-move-to-filename)
3357 0 : (if (null wrap)
3358 0 : (progn
3359 0 : (goto-char opoint)
3360 0 : (error "No next marked file"))
3361 0 : (message "(Wraparound for next marked file)")
3362 0 : (goto-char (if (> arg 0) (point-min) (point-max)))
3363 0 : (dired-next-marked-file arg nil opoint))))
3364 :
3365 : (defun dired-prev-marked-file (arg &optional wrap)
3366 : "Move to the previous marked file.
3367 : If WRAP is non-nil, wrap around to the end of the buffer if we
3368 : reach the beginning of the buffer."
3369 : (interactive "p\np")
3370 0 : (dired-next-marked-file (- arg) wrap))
3371 :
3372 : (defun dired-file-marker (file)
3373 : ;; Return FILE's marker, or nil if unmarked.
3374 0 : (save-excursion
3375 0 : (and (dired-goto-file file)
3376 0 : (progn
3377 0 : (beginning-of-line)
3378 0 : (if (not (equal ?\040 (following-char)))
3379 0 : (following-char))))))
3380 :
3381 : (defun dired-mark-files-in-region (start end)
3382 0 : (let ((inhibit-read-only t))
3383 0 : (if (> start end)
3384 0 : (error "start > end"))
3385 0 : (goto-char start) ; assumed at beginning of line
3386 0 : (while (< (point) end)
3387 : ;; Skip subdir line and following garbage like the `total' line:
3388 0 : (while (and (< (point) end) (dired-between-files))
3389 0 : (forward-line 1))
3390 0 : (if (and (not (looking-at-p dired-re-dot))
3391 0 : (dired-get-filename nil t))
3392 0 : (progn
3393 0 : (delete-char 1)
3394 0 : (insert dired-marker-char)))
3395 0 : (forward-line 1))))
3396 :
3397 : (defun dired-mark (arg &optional interactive)
3398 : "Mark the file at point in the Dired buffer.
3399 : If the region is active, mark all files in the region.
3400 : Otherwise, with a prefix arg, mark files on the next ARG lines.
3401 :
3402 : If on a subdir headerline, mark all its files except `.' and `..'.
3403 :
3404 : Use \\[dired-unmark-all-files] to remove all marks
3405 : and \\[dired-unmark] on a subdir to remove the marks in
3406 : this subdir."
3407 0 : (interactive (list current-prefix-arg t))
3408 0 : (cond
3409 : ;; Mark files in the active region.
3410 0 : ((and interactive (use-region-p))
3411 0 : (save-excursion
3412 0 : (let ((beg (region-beginning))
3413 0 : (end (region-end)))
3414 0 : (dired-mark-files-in-region
3415 0 : (progn (goto-char beg) (line-beginning-position))
3416 0 : (progn (goto-char end) (line-beginning-position))))))
3417 : ;; Mark subdir files from the subdir headerline.
3418 0 : ((dired-get-subdir)
3419 0 : (save-excursion (dired-mark-subdir-files)))
3420 : ;; Mark the current (or next ARG) files.
3421 : (t
3422 0 : (let ((inhibit-read-only t))
3423 0 : (dired-repeat-over-lines
3424 0 : (prefix-numeric-value arg)
3425 0 : (lambda () (delete-char 1) (insert dired-marker-char)))))))
3426 :
3427 : (defun dired-unmark (arg &optional interactive)
3428 : "Unmark the file at point in the Dired buffer.
3429 : If the region is active, unmark all files in the region.
3430 : Otherwise, with a prefix arg, unmark files on the next ARG lines.
3431 :
3432 : If looking at a subdir, unmark all its files except `.' and `..'.
3433 : If the region is active in Transient Mark mode, unmark all files
3434 : in the active region."
3435 0 : (interactive (list current-prefix-arg t))
3436 0 : (let ((dired-marker-char ?\040))
3437 0 : (dired-mark arg interactive)))
3438 :
3439 : (defun dired-flag-file-deletion (arg &optional interactive)
3440 : "In Dired, flag the current line's file for deletion.
3441 : If the region is active, flag all files in the region.
3442 : Otherwise, with a prefix arg, flag files on the next ARG lines.
3443 :
3444 : If on a subdir headerline, flag all its files except `.' and `..'.
3445 : If the region is active in Transient Mark mode, flag all files
3446 : in the active region."
3447 0 : (interactive (list current-prefix-arg t))
3448 0 : (let ((dired-marker-char dired-del-marker))
3449 0 : (dired-mark arg interactive)))
3450 :
3451 : (defun dired-unmark-backward (arg)
3452 : "In Dired, move up lines and remove marks or deletion flags there.
3453 : Optional prefix ARG says how many lines to unmark/unflag; default
3454 : is one line.
3455 : If the region is active in Transient Mark mode, unmark all files
3456 : in the active region."
3457 : (interactive "p")
3458 0 : (dired-unmark (- arg) t))
3459 :
3460 : (defun dired-toggle-marks ()
3461 : "Toggle marks: marked files become unmarked, and vice versa.
3462 : Files marked with other flags (such as `D') are not affected.
3463 : `.' and `..' are never toggled.
3464 : As always, hidden subdirs are not affected."
3465 : (interactive)
3466 0 : (save-excursion
3467 0 : (goto-char (point-min))
3468 0 : (let ((inhibit-read-only t))
3469 0 : (while (not (eobp))
3470 0 : (or (dired-between-files)
3471 0 : (looking-at-p dired-re-dot)
3472 : ;; use subst instead of insdel because it does not move
3473 : ;; the gap and thus should be faster and because
3474 : ;; other characters are left alone automatically
3475 0 : (apply 'subst-char-in-region
3476 0 : (point) (1+ (point))
3477 0 : (if (eq ?\040 (following-char)) ; SPC
3478 0 : (list ?\040 dired-marker-char)
3479 0 : (list dired-marker-char ?\040))))
3480 0 : (forward-line 1)))))
3481 :
3482 : ;;; Commands to mark or flag files based on their characteristics or names.
3483 :
3484 : (defvar dired-regexp-history nil
3485 : "History list of regular expressions used in Dired commands.")
3486 :
3487 : (defun dired-read-regexp (prompt &optional default history)
3488 : "Read a regexp using `read-regexp'."
3489 : (declare (obsolete read-regexp "24.5"))
3490 0 : (read-regexp prompt default (or history 'dired-regexp-history)))
3491 :
3492 : (defun dired-mark-files-regexp (regexp &optional marker-char)
3493 : "Mark all files matching REGEXP for use in later commands.
3494 : A prefix argument means to unmark them instead.
3495 : `.' and `..' are never marked.
3496 :
3497 : REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
3498 : object files--just `.o' will mark more than you might think."
3499 : (interactive
3500 0 : (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
3501 0 : " files (regexp): ")
3502 : ;; Add more suggestions into the default list
3503 0 : (cons nil (list (dired-get-filename t t)
3504 0 : (and (dired-get-filename nil t)
3505 0 : (concat (regexp-quote
3506 0 : (file-name-extension
3507 0 : (dired-get-filename nil t) t))
3508 0 : "\\'"))))
3509 0 : 'dired-regexp-history)
3510 0 : (if current-prefix-arg ?\040)))
3511 0 : (let ((dired-marker-char (or marker-char dired-marker-char)))
3512 0 : (dired-mark-if
3513 : (and (not (looking-at-p dired-re-dot))
3514 : (not (eolp)) ; empty line
3515 : (let ((fn (dired-get-filename t t)))
3516 : (and fn (string-match-p regexp fn))))
3517 0 : "matching file")))
3518 :
3519 : (defun dired-mark-files-containing-regexp (regexp &optional marker-char)
3520 : "Mark all files with contents containing REGEXP for use in later commands.
3521 : A prefix argument means to unmark them instead.
3522 : `.' and `..' are never marked.
3523 :
3524 : Note that if a file is visited in an Emacs buffer, and
3525 : `dired-always-read-filesystem' is nil, this command will
3526 : look in the buffer without revisiting the file, so the results might
3527 : be inconsistent with the file on disk if its contents has changed
3528 : since it was last visited."
3529 : (interactive
3530 0 : (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
3531 0 : " files containing (regexp): ")
3532 0 : nil 'dired-regexp-history)
3533 0 : (if current-prefix-arg ?\040)))
3534 0 : (let ((dired-marker-char (or marker-char dired-marker-char)))
3535 0 : (dired-mark-if
3536 : (and (not (looking-at-p dired-re-dot))
3537 : (not (eolp)) ; empty line
3538 : (let ((fn (dired-get-filename nil t)))
3539 : (when (and fn (file-readable-p fn)
3540 : (not (file-directory-p fn)))
3541 : (let ((prebuf (get-file-buffer fn)))
3542 : (message "Checking %s" fn)
3543 : ;; For now we do it inside emacs
3544 : ;; Grep might be better if there are a lot of files
3545 : (if (and prebuf (not dired-always-read-filesystem))
3546 : (with-current-buffer prebuf
3547 : (save-excursion
3548 : (goto-char (point-min))
3549 : (re-search-forward regexp nil t)))
3550 : (with-temp-buffer
3551 : (insert-file-contents fn)
3552 : (goto-char (point-min))
3553 : (re-search-forward regexp nil t))))
3554 : )))
3555 0 : "matching file")))
3556 :
3557 : (defun dired-flag-files-regexp (regexp)
3558 : "In Dired, flag all files containing the specified REGEXP for deletion.
3559 : The match is against the non-directory part of the filename. Use `^'
3560 : and `$' to anchor matches. Exclude subdirs by hiding them.
3561 : `.' and `..' are never flagged."
3562 0 : (interactive (list (read-regexp "Flag for deletion (regexp): "
3563 0 : nil 'dired-regexp-history)))
3564 0 : (dired-mark-files-regexp regexp dired-del-marker))
3565 :
3566 : (defun dired-mark-symlinks (unflag-p)
3567 : "Mark all symbolic links.
3568 : With prefix argument, unmark or unflag all those files."
3569 : (interactive "P")
3570 0 : (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
3571 0 : (dired-mark-if (looking-at-p dired-re-sym) "symbolic link")))
3572 :
3573 : (defun dired-mark-directories (unflag-p)
3574 : "Mark all directory file lines except `.' and `..'.
3575 : With prefix argument, unmark or unflag all those files."
3576 : (interactive "P")
3577 0 : (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
3578 0 : (dired-mark-if (and (looking-at-p dired-re-dir)
3579 : (not (looking-at-p dired-re-dot)))
3580 0 : "directory file")))
3581 :
3582 : (defun dired-mark-executables (unflag-p)
3583 : "Mark all executable files.
3584 : With prefix argument, unmark or unflag all those files."
3585 : (interactive "P")
3586 0 : (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
3587 0 : (dired-mark-if (looking-at-p dired-re-exe) "executable file")))
3588 :
3589 : ;; dired-x.el has a dired-mark-sexp interactive command: mark
3590 : ;; files for which PREDICATE returns non-nil.
3591 :
3592 : (defun dired-flag-auto-save-files (&optional unflag-p)
3593 : "Flag for deletion files whose names suggest they are auto save files.
3594 : A prefix argument says to unmark or unflag those files instead."
3595 : (interactive "P")
3596 0 : (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
3597 0 : (dired-mark-if
3598 : ;; It is less than general to check for # here,
3599 : ;; but it's the only way this runs fast enough.
3600 : (and (save-excursion (end-of-line)
3601 : (or
3602 : (eq (preceding-char) ?#)
3603 : ;; Handle executables in case of -F option.
3604 : ;; We need not worry about the other kinds
3605 : ;; of markings that -F makes, since they won't
3606 : ;; appear on real auto-save files.
3607 : (if (eq (preceding-char) ?*)
3608 : (progn
3609 : (forward-char -1)
3610 : (eq (preceding-char) ?#)))))
3611 : (not (looking-at-p dired-re-dir))
3612 : (let ((fn (dired-get-filename t t)))
3613 : (if fn (auto-save-file-name-p
3614 : (file-name-nondirectory fn)))))
3615 0 : "auto save file")))
3616 :
3617 : (defcustom dired-garbage-files-regexp
3618 : ;; `log' here is dubious, since it's typically used for useful log
3619 : ;; files, not just TeX stuff. -- fx
3620 : (concat (regexp-opt
3621 : '(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux"))
3622 : "\\'")
3623 : "Regular expression to match \"garbage\" files for `dired-flag-garbage-files'."
3624 : :type 'regexp
3625 : :group 'dired)
3626 :
3627 : (defun dired-flag-garbage-files ()
3628 : "Flag for deletion all files that match `dired-garbage-files-regexp'."
3629 : (interactive)
3630 0 : (dired-flag-files-regexp dired-garbage-files-regexp))
3631 :
3632 : (defun dired-flag-backup-files (&optional unflag-p)
3633 : "Flag all backup files (names ending with `~') for deletion.
3634 : With prefix argument, unmark or unflag these files."
3635 : (interactive "P")
3636 0 : (let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
3637 0 : (dired-mark-if
3638 : ;; Don't call backup-file-name-p unless the last character looks like
3639 : ;; it might be the end of a backup file name. This isn't very general,
3640 : ;; but it's the only way this runs fast enough.
3641 : (and (save-excursion (end-of-line)
3642 : ;; Handle executables in case of -F option.
3643 : ;; We need not worry about the other kinds
3644 : ;; of markings that -F makes, since they won't
3645 : ;; appear on real backup files.
3646 : (if (eq (preceding-char) ?*)
3647 : (forward-char -1))
3648 : (eq (preceding-char) ?~))
3649 : (not (looking-at-p dired-re-dir))
3650 : (let ((fn (dired-get-filename t t)))
3651 : (if fn (backup-file-name-p fn))))
3652 0 : "backup file")))
3653 :
3654 : (defun dired-change-marks (&optional old new)
3655 : "Change all OLD marks to NEW marks.
3656 : OLD and NEW are both characters used to mark files."
3657 : (interactive
3658 0 : (let* ((cursor-in-echo-area t)
3659 0 : (old (progn (message "Change (old mark): ") (read-char)))
3660 0 : (new (progn (message "Change %c marks to (new mark): " old)
3661 0 : (read-char))))
3662 0 : (list old new)))
3663 0 : (if (or (eq old ?\r) (eq new ?\r))
3664 0 : (ding)
3665 0 : (let ((string (format "\n%c" old))
3666 : (inhibit-read-only t))
3667 0 : (save-excursion
3668 0 : (goto-char (point-min))
3669 0 : (while (search-forward string nil t)
3670 0 : (if (if (= old ?\s)
3671 0 : (save-match-data
3672 0 : (dired-get-filename 'no-dir t))
3673 0 : t)
3674 0 : (subst-char-in-region (match-beginning 0)
3675 0 : (match-end 0) old new)))))))
3676 :
3677 : (defun dired-unmark-all-marks ()
3678 : "Remove all marks from all files in the Dired buffer."
3679 : (interactive)
3680 0 : (dired-unmark-all-files ?\r))
3681 :
3682 : ;; Bound in dired-unmark-all-files
3683 : (defvar dired-unmark-all-files-query)
3684 :
3685 : (defun dired-unmark-all-files (mark &optional arg)
3686 : "Remove a specific mark (or any mark) from every file.
3687 : After this command, type the mark character to remove,
3688 : or type RET to remove all marks.
3689 : With prefix arg, query for each marked file.
3690 : Type \\[help-command] at that time for help."
3691 : (interactive "cRemove marks (RET means all): \nP")
3692 0 : (save-excursion
3693 0 : (let* ((count 0)
3694 : (inhibit-read-only t) case-fold-search
3695 : dired-unmark-all-files-query
3696 0 : (string (format "\n%c" mark))
3697 : (help-form "\
3698 : Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
3699 : `!' to unmark all remaining files with no more questions."))
3700 0 : (goto-char (point-min))
3701 0 : (while (if (eq mark ?\r)
3702 0 : (re-search-forward dired-re-mark nil t)
3703 0 : (search-forward string nil t))
3704 0 : (if (or (not arg)
3705 0 : (let ((file (dired-get-filename t t)))
3706 0 : (and file
3707 0 : (dired-query 'dired-unmark-all-files-query
3708 : "Unmark file `%s'? "
3709 0 : file))))
3710 0 : (progn (subst-char-in-region (1- (point)) (point)
3711 0 : (preceding-char) ?\s)
3712 0 : (setq count (1+ count)))))
3713 0 : (message (if (= count 1) "1 mark removed"
3714 0 : "%d marks removed")
3715 0 : count))))
3716 :
3717 : ;; Logging failures operating on files, and showing the results.
3718 :
3719 : (defvar dired-log-buffer "*Dired log*")
3720 :
3721 : (defun dired-why ()
3722 : "Pop up a buffer with error log output from Dired.
3723 : A group of errors from a single command ends with a formfeed.
3724 : Thus, use \\[backward-page] to find the beginning of a group of errors."
3725 : (interactive)
3726 0 : (if (get-buffer dired-log-buffer)
3727 0 : (let ((owindow (selected-window))
3728 0 : (window (display-buffer (get-buffer dired-log-buffer))))
3729 0 : (unwind-protect
3730 0 : (progn
3731 0 : (select-window window)
3732 0 : (goto-char (point-max))
3733 0 : (forward-line -1)
3734 0 : (backward-page 1)
3735 0 : (recenter 0))
3736 0 : (select-window owindow)))))
3737 :
3738 : (defun dired-log (log &rest args)
3739 : ;; Log a message or the contents of a buffer.
3740 : ;; If LOG is a string and there are more args, it is formatted with
3741 : ;; those ARGS. Usually the LOG string ends with a \n.
3742 : ;; End each bunch of errors with (dired-log t):
3743 : ;; this inserts the current time and buffer at the start of the page,
3744 : ;; and \f (formfeed) at the end.
3745 0 : (let ((obuf (current-buffer)))
3746 0 : (with-current-buffer (get-buffer-create dired-log-buffer)
3747 0 : (goto-char (point-max))
3748 0 : (let ((inhibit-read-only t))
3749 0 : (cond ((stringp log)
3750 0 : (insert (if args
3751 0 : (apply #'format-message log args)
3752 0 : log)))
3753 0 : ((bufferp log)
3754 0 : (insert-buffer-substring log))
3755 0 : ((eq t log)
3756 0 : (backward-page 1)
3757 0 : (unless (bolp)
3758 0 : (insert "\n"))
3759 0 : (insert (current-time-string)
3760 0 : (format-message "\tBuffer `%s'\n" (buffer-name obuf)))
3761 0 : (goto-char (point-max))
3762 0 : (insert "\f\n")))))))
3763 :
3764 : (defun dired-log-summary (string failures)
3765 : "State a summary of a command's failures, in echo area and log buffer.
3766 : STRING is an overall summary of the failures.
3767 : FAILURES is a list of file names that we failed to operate on,
3768 : or nil if file names are not applicable."
3769 0 : (if (= (length failures) 1)
3770 0 : (message "%s"
3771 0 : (with-current-buffer dired-log-buffer
3772 0 : (goto-char (point-max))
3773 0 : (backward-page 1)
3774 0 : (if (eolp) (forward-line 1))
3775 0 : (buffer-substring (point) (point-max))))
3776 0 : (message (if failures "%s--type ? for details (%s)"
3777 0 : "%s--type ? for details")
3778 0 : string failures))
3779 : ;; Log a summary describing a bunch of errors.
3780 0 : (dired-log (concat "\n" string "\n"))
3781 0 : (dired-log t))
3782 :
3783 : ;;; Sorting
3784 :
3785 : ;; Most ls can only sort by name or by date (with -t), nothing else.
3786 : ;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
3787 : ;; So anything that does not contain these is sort "by name".
3788 :
3789 : (defvar dired-ls-sorting-switches "SXU"
3790 : "String of `ls' switches (single letters) except \"t\" that influence sorting.
3791 :
3792 : This indicates to Dired which option switches to watch out for because they
3793 : will change the sorting order behavior of `ls'.
3794 :
3795 : To change the default sorting order (e.g. add a `-v' option), see the
3796 : variable `dired-listing-switches'. To temporarily override the listing
3797 : format, use `\\[universal-argument] \\[dired]'.")
3798 :
3799 : (defvar dired-sort-by-date-regexp
3800 : (concat "\\(\\`\\| \\)-[^- ]*t"
3801 : ;; `dired-ls-sorting-switches' after -t overrides -t.
3802 : "[^ " dired-ls-sorting-switches "]*"
3803 : "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t"
3804 : dired-ls-sorting-switches "]+\\)\\)* *$")
3805 : "Regexp recognized by Dired to set `by date' mode.")
3806 :
3807 : (defvar dired-sort-by-name-regexp
3808 : (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|"
3809 : "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$")
3810 : "Regexp recognized by Dired to set `by name' mode.")
3811 :
3812 : (defvar dired-sort-inhibit nil
3813 : "Non-nil means the Dired sort command is disabled.
3814 : The idea is to set this buffer-locally in special Dired buffers.")
3815 :
3816 : (defun dired-sort-set-mode-line ()
3817 : ;; Set mode line display according to dired-actual-switches.
3818 : ;; Mode line display of "by name" or "by date" guarantees the user a
3819 : ;; match with the corresponding regexps. Non-matching switches are
3820 : ;; shown literally.
3821 6 : (when (eq major-mode 'dired-mode)
3822 6 : (setq mode-name
3823 6 : (let (case-fold-search)
3824 6 : (cond ((string-match-p
3825 6 : dired-sort-by-name-regexp dired-actual-switches)
3826 : "Dired by name")
3827 0 : ((string-match-p
3828 0 : dired-sort-by-date-regexp dired-actual-switches)
3829 : "Dired by date")
3830 : (t
3831 6 : (concat "Dired " dired-actual-switches)))))
3832 6 : (force-mode-line-update)))
3833 :
3834 : (define-obsolete-function-alias 'dired-sort-set-modeline
3835 : 'dired-sort-set-mode-line "24.3")
3836 :
3837 : (defun dired-sort-toggle-or-edit (&optional arg)
3838 : "Toggle sorting by date, and refresh the Dired buffer.
3839 : With a prefix argument, edit the current listing switches instead."
3840 : (interactive "P")
3841 0 : (when dired-sort-inhibit
3842 0 : (error "Cannot sort this Dired buffer"))
3843 0 : (if arg
3844 0 : (dired-sort-other
3845 0 : (read-string "ls switches (must contain -l): " dired-actual-switches))
3846 0 : (dired-sort-toggle)))
3847 :
3848 : (defun dired-sort-toggle ()
3849 : ;; Toggle between sort by date/name. Reverts the buffer.
3850 0 : (let ((sorting-by-date (string-match-p dired-sort-by-date-regexp
3851 0 : dired-actual-switches))
3852 : ;; Regexp for finding (possibly embedded) -t switches.
3853 : (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)")
3854 : case-fold-search)
3855 : ;; Remove the -t switch.
3856 0 : (while (string-match switch-regexp dired-actual-switches)
3857 0 : (if (and (equal (match-string 2 dired-actual-switches) "")
3858 0 : (equal (match-string 4 dired-actual-switches) ""))
3859 : ;; Remove a stand-alone -t switch.
3860 0 : (setq dired-actual-switches
3861 0 : (replace-match "" t t dired-actual-switches))
3862 : ;; Remove a switch of the form -XtY for some X and Y.
3863 0 : (setq dired-actual-switches
3864 0 : (replace-match "" t t dired-actual-switches 3))))
3865 :
3866 : ;; Now, if we weren't sorting by date before, add the -t switch.
3867 : ;; Some simple-minded ls implementations (eg ftp servers) only
3868 : ;; allow a single option string, so try not to add " -t" if possible.
3869 0 : (unless sorting-by-date
3870 0 : (setq dired-actual-switches
3871 0 : (concat dired-actual-switches
3872 0 : (if (string-match-p "\\`-[[:alnum:]]+\\'"
3873 0 : dired-actual-switches)
3874 : "t"
3875 0 : " -t")))))
3876 0 : (dired-sort-set-mode-line)
3877 0 : (revert-buffer))
3878 :
3879 : ;; Some user code loads dired especially for this.
3880 : ;; Don't do that--use replace-regexp-in-string instead.
3881 : (defun dired-replace-in-string (regexp newtext string)
3882 : ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
3883 : ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
3884 4 : (let ((result "") (start 0) mb me)
3885 8 : (while (string-match regexp string start)
3886 4 : (setq mb (match-beginning 0)
3887 4 : me (match-end 0)
3888 4 : result (concat result (substring string start mb) newtext)
3889 4 : start me))
3890 4 : (concat result (substring string start))))
3891 :
3892 : (defun dired-sort-other (switches &optional no-revert)
3893 : "Specify new `ls' SWITCHES for current Dired buffer.
3894 : Values matching `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp'
3895 : set the minor mode accordingly, others appear literally in the mode line.
3896 : With optional second arg NO-REVERT, don't refresh the listing afterwards."
3897 6 : (dired-sort-R-check switches)
3898 6 : (setq dired-actual-switches switches)
3899 6 : (dired-sort-set-mode-line)
3900 6 : (or no-revert (revert-buffer)))
3901 :
3902 : (defvar-local dired-subdir-alist-pre-R nil
3903 : "Value of `dired-subdir-alist' before -R switch added.")
3904 :
3905 : (defun dired-sort-R-check (switches)
3906 : "Additional processing of -R in ls option string SWITCHES.
3907 : Saves `dired-subdir-alist' when R is set and restores saved value
3908 : minus any directories explicitly deleted when R is cleared.
3909 : To be called first in body of `dired-sort-other', etc."
3910 6 : (cond
3911 6 : ((and (dired-switches-recursive-p switches)
3912 6 : (not (dired-switches-recursive-p dired-actual-switches)))
3913 : ;; Adding -R to ls switches -- save `dired-subdir-alist':
3914 0 : (setq dired-subdir-alist-pre-R dired-subdir-alist))
3915 6 : ((and (dired-switches-recursive-p dired-actual-switches)
3916 6 : (not (dired-switches-recursive-p switches)))
3917 : ;; Deleting -R from ls switches -- revert to pre-R subdirs
3918 : ;; that are still present:
3919 0 : (setq dired-subdir-alist
3920 0 : (if dired-subdir-alist-pre-R
3921 0 : (let (subdirs)
3922 0 : (while dired-subdir-alist-pre-R
3923 0 : (if (assoc (caar dired-subdir-alist-pre-R)
3924 0 : dired-subdir-alist)
3925 : ;; subdir still present...
3926 0 : (setq subdirs
3927 0 : (cons (car dired-subdir-alist-pre-R)
3928 0 : subdirs)))
3929 0 : (setq dired-subdir-alist-pre-R
3930 0 : (cdr dired-subdir-alist-pre-R)))
3931 0 : (reverse subdirs))
3932 : ;; No pre-R subdir alist, so revert to main directory
3933 : ;; listing:
3934 6 : (list (car (reverse dired-subdir-alist))))))))
3935 :
3936 :
3937 : ;;;; Drag and drop support
3938 :
3939 : (defcustom dired-recursive-copies 'top
3940 : "Whether Dired copies directories recursively.
3941 : If nil, never copy recursively.
3942 : `always' means to copy recursively without asking.
3943 : `top' means to ask for each directory at top level.
3944 : Any other value means to ask for each directory."
3945 : :type '(choice :tag "Copy directories"
3946 : (const :tag "No recursive copies" nil)
3947 : (const :tag "Ask for each directory" t)
3948 : (const :tag "Ask for each top directory only" top)
3949 : (const :tag "Copy directories without asking" always))
3950 : :group 'dired)
3951 :
3952 : (defun dired-dnd-popup-notice ()
3953 0 : (message-box
3954 0 : "Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'."))
3955 :
3956 : (declare-function x-popup-menu "menu.c" (position menu))
3957 :
3958 : (defun dired-dnd-do-ask-action (uri)
3959 : ;; No need to get actions and descriptions from the source,
3960 : ;; we only have three actions anyway.
3961 0 : (let ((action (x-popup-menu
3962 : t
3963 0 : (list "What action?"
3964 0 : (cons ""
3965 : '(("Copy here" . copy)
3966 : ("Move here" . move)
3967 : ("Link here" . link)
3968 : "--"
3969 0 : ("Cancel" . nil)))))))
3970 0 : (if action
3971 0 : (dired-dnd-handle-local-file uri action)
3972 0 : nil)))
3973 :
3974 : (declare-function dired-relist-entry "dired-aux" (file))
3975 : (declare-function make-symbolic-link "fileio.c")
3976 :
3977 : ;; Only used when (featurep 'dnd).
3978 : (declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist))
3979 : (declare-function dnd-get-local-file-uri "dnd" (uri))
3980 :
3981 : (defvar dired-overwrite-confirmed) ;Defined in dired-aux.
3982 :
3983 : (defun dired-dnd-handle-local-file (uri action)
3984 : "Copy, move or link a file to the Dired directory.
3985 : URI is the file to handle, ACTION is one of copy, move, link or ask.
3986 : Ask means pop up a menu for the user to select one of copy, move or link."
3987 0 : (require 'dired-aux)
3988 0 : (let* ((from (dnd-get-local-file-name uri t))
3989 0 : (to (when from
3990 0 : (concat (dired-current-directory)
3991 0 : (file-name-nondirectory from)))))
3992 0 : (when from
3993 0 : (cond ((eq action 'ask)
3994 0 : (dired-dnd-do-ask-action uri))
3995 : ;; If copying a directory and dired-recursive-copies is
3996 : ;; nil, dired-copy-file fails. Pop up a notice.
3997 0 : ((and (memq action '(copy private))
3998 0 : (file-directory-p from)
3999 0 : (not dired-recursive-copies))
4000 0 : (dired-dnd-popup-notice))
4001 0 : ((memq action '(copy private move link))
4002 0 : (let ((overwrite (and (file-exists-p to)
4003 0 : (y-or-n-p
4004 0 : (format-message
4005 0 : "Overwrite existing file `%s'? " to))))
4006 : ;; Binding dired-overwrite-confirmed to nil makes
4007 : ;; dired-handle-overwrite a no-op. We instead use
4008 : ;; y-or-n-p, which pops a graphical menu.
4009 : dired-overwrite-confirmed backup-file)
4010 0 : (when (and overwrite
4011 : ;; d-b-o is defined in dired-aux.
4012 0 : (boundp 'dired-backup-overwrite)
4013 0 : dired-backup-overwrite
4014 0 : (setq backup-file
4015 0 : (car (find-backup-file-name to)))
4016 0 : (or (eq dired-backup-overwrite 'always)
4017 0 : (y-or-n-p
4018 0 : (format-message
4019 0 : "Make backup for existing file `%s'? " to))))
4020 0 : (rename-file to backup-file 0)
4021 0 : (dired-relist-entry backup-file))
4022 0 : (cond ((memq action '(copy private))
4023 0 : (dired-copy-file from to overwrite))
4024 0 : ((eq action 'move)
4025 0 : (dired-rename-file from to overwrite))
4026 0 : ((eq action 'link)
4027 0 : (make-symbolic-link from to overwrite)))
4028 0 : (dired-relist-entry to)
4029 0 : action))))))
4030 :
4031 : (defun dired-dnd-handle-file (uri action)
4032 : "Copy, move or link a file to the Dired directory if it is a local file.
4033 : URI is the file to handle. If the hostname in the URI isn't local, do nothing.
4034 : ACTION is one of copy, move, link or ask.
4035 : Ask means pop up a menu for the user to select one of copy, move or link."
4036 0 : (let ((local-file (dnd-get-local-file-uri uri)))
4037 0 : (if local-file (dired-dnd-handle-local-file local-file action)
4038 0 : nil)))
4039 :
4040 :
4041 : ;;;; Desktop support
4042 :
4043 : (eval-when-compile (require 'desktop))
4044 : (declare-function desktop-file-name "desktop" (filename dirname))
4045 :
4046 : (defun dired-desktop-buffer-misc-data (dirname)
4047 : "Auxiliary information to be saved in desktop file."
4048 0 : (cons
4049 : ;; Value of `dired-directory'.
4050 0 : (if (consp dired-directory)
4051 : ;; Directory name followed by list of files.
4052 0 : (cons (desktop-file-name (car dired-directory) dirname)
4053 0 : (cdr dired-directory))
4054 : ;; Directory name, optionally with shell wildcard.
4055 0 : (desktop-file-name dired-directory dirname))
4056 : ;; Subdirectories in `dired-subdir-alist'.
4057 0 : (cdr
4058 0 : (nreverse
4059 0 : (mapcar
4060 0 : (lambda (f) (desktop-file-name (car f) dirname))
4061 0 : dired-subdir-alist)))))
4062 :
4063 : (defun dired-restore-desktop-buffer (_file-name
4064 : _buffer-name
4065 : misc-data)
4066 : "Restore a Dired buffer specified in a desktop file."
4067 : ;; First element of `misc-data' is the value of `dired-directory'.
4068 : ;; This value is a directory name, optionally with shell wildcard or
4069 : ;; a directory name followed by list of files.
4070 0 : (let* ((dired-dir (car misc-data))
4071 0 : (dir (if (consp dired-dir) (car dired-dir) dired-dir)))
4072 0 : (if (file-directory-p (file-name-directory dir))
4073 0 : (with-demoted-errors "Desktop: Problem restoring directory: %S"
4074 0 : (dired dired-dir)
4075 : ;; The following elements of `misc-data' are the keys
4076 : ;; from `dired-subdir-alist'.
4077 0 : (mapc 'dired-maybe-insert-subdir (cdr misc-data))
4078 0 : (current-buffer))
4079 0 : (message "Desktop: Directory %s no longer exists." dir)
4080 0 : (when desktop-missing-file-warning (sit-for 1))
4081 0 : nil)))
4082 :
4083 : (add-to-list 'desktop-buffer-mode-handlers
4084 : '(dired-mode . dired-restore-desktop-buffer))
4085 :
4086 : (provide 'dired)
4087 :
4088 : (run-hooks 'dired-load-hook) ; for your customizations
4089 :
4090 : ;;; dired.el ends here
|