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