|
0
|
1 ;;; dired.el --- directory-browsing commands
|
|
|
2 ;; Keywords: dired extensions
|
|
|
3
|
|
|
4 ;; Copyright (C) 1985, 1986, 1991, 1992 Free Software Foundation, Inc.
|
|
|
5
|
|
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
21
|
|
|
22 ;; Rewritten in 1990/1991 to add tree features, file marking and
|
|
|
23 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
|
|
|
24
|
|
|
25 (provide 'dired)
|
|
|
26
|
|
|
27 (defconst dired-version (substring "!Revision: 6.0 !" 11 -2)
|
|
|
28 "The revision number of Tree Dired (as string). The complete RCS id is:
|
|
|
29
|
|
|
30 !Id: dired.el,v 6.0 1992/05/15 14:25:45 sk RelBeta !
|
|
|
31
|
|
|
32 Don't forget to mention this when reporting bugs to:
|
|
|
33
|
|
|
34 Sebastian Kremer <sk@thp.uni-koeln.de>
|
|
|
35
|
|
|
36 Tree dired is available for anonymous ftp in USA in:
|
|
|
37
|
|
|
38 ftp.cs.buffalo.edu:pub/Emacs/diredall.tar.Z
|
|
|
39
|
|
|
40 and in Europe at my own site in Germany:
|
|
|
41
|
|
|
42 ftp.uni-koeln.de:/pub/gnu/emacs/diredall.tar.Z")
|
|
|
43 ;; Should perhaps later give bug-gnu-emacs@prep.gnu.ai.mit.edu instead.
|
|
|
44
|
|
|
45 ;; compatibility package when using Emacs 18.55
|
|
|
46 ;; XEmacs fix:
|
|
|
47 (defvar dired-emacs-19-p (not (equal (substring emacs-version 0 2) "18")))
|
|
|
48 ;;;#### install (is there a better way to test for Emacs 19?)
|
|
|
49 (or dired-emacs-19-p
|
|
|
50 (require 'emacs-19))
|
|
|
51
|
|
|
52 ;;; Customizable variables
|
|
|
53
|
|
|
54 ;;; The funny comments are for autoload.el, to automagically update
|
|
|
55 ;;; loaddefs.
|
|
|
56
|
|
|
57 (defvar dired-use-gzip-instead-of-compress t
|
|
|
58 "*If non-nil, use gzip instead of compress as the standard compress
|
|
|
59 program")
|
|
|
60
|
|
|
61 (defvar dired-make-gzip-quiet t
|
|
|
62 "*If non-nil, pass -q to shell commands involving gzip this will override
|
|
|
63 GZIP environment variable.")
|
|
|
64
|
|
|
65 (defvar dired-znew-switches nil
|
|
|
66 "*If non-nil, a string of switches that will be passed to `znew'
|
|
|
67 example: \"-K\"")
|
|
|
68
|
|
|
69 (defvar dired-gzip-file-extension ".gz"
|
|
|
70 "*A string representing the suffix created by gzip. This should probably
|
|
|
71 match the value of --suffix or -S in the GZIP environment variable if it
|
|
|
72 exists and \".gz\" if it does not.")
|
|
|
73
|
|
|
74 ;;;###autoload
|
|
|
75 (defvar dired-listing-switches (purecopy "-al")
|
|
|
76 "*Switches passed to ls for dired. MUST contain the `l' option.
|
|
|
77 Can contain even `F', `b', `i' and `s'.")
|
|
|
78
|
|
|
79 ; Don't use absolute paths as /bin should be in any PATH and people
|
|
|
80 ; may prefer /usr/local/gnu/bin or whatever. However, chown is
|
|
|
81 ; usually not in PATH.
|
|
|
82
|
|
|
83 ;;;###autoload
|
|
|
84 (defvar dired-chown-program
|
|
|
85 (purecopy
|
|
|
86 (if (memq system-type '(dgux-unix hpux usg-unix-v silicon-graphics-unix irix))
|
|
|
87 "chown" "/etc/chown"))
|
|
|
88 "*Name of chown command (usully `chown' or `/etc/chown').")
|
|
|
89
|
|
|
90 ;;;###autoload
|
|
|
91 (defvar dired-ls-program (purecopy "ls")
|
|
|
92 "*Absolute or relative name of the ls program used by dired.")
|
|
|
93
|
|
|
94 ;;;###autoload
|
|
|
95 (defvar dired-ls-F-marks-symlinks t
|
|
|
96 "*Informs dired about how ls -lF marks symbolic links.
|
|
|
97 Set this to t if `dired-ls-program' with -lF marks the symbolic link
|
|
|
98 itself with a trailing @ (usually the case under Ultrix).
|
|
|
99
|
|
|
100 Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
|
|
|
101 nil, if it gives `bar@ -> foo', set it to t.
|
|
|
102
|
|
|
103 Dired checks if there is really a @ appended. Thus, if you have a
|
|
|
104 marking ls program on one host and a non-marking on another host, and
|
|
|
105 don't care about symbolic links which really end in a @, you can
|
|
|
106 always set this variable to t.")
|
|
|
107
|
|
|
108 ;;;###autoload
|
|
|
109 (defvar dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
|
|
|
110 "*Regexp of files to skip when moving point to the first file of a new directory listing.
|
|
|
111 Nil means move to the subdir line, t means move to first file.")
|
|
|
112
|
|
|
113 ;;;###autoload
|
|
|
114 (defvar dired-keep-marker-move t
|
|
|
115 ;; Use t as default so that moved files `take their markers with them'
|
|
|
116 "If t, moved marked files are marked if their originals were.
|
|
|
117 If a character, those files (marked or not) are marked with that character.")
|
|
|
118
|
|
|
119 ;;;###autoload
|
|
|
120 (defvar dired-keep-marker-copy ?C
|
|
|
121 "If t, copied files are marked if their source files were.
|
|
|
122 If a character, those files are always marked with that character.")
|
|
|
123
|
|
|
124 ;;;###autoload
|
|
|
125 (defvar dired-keep-marker-hardlink ?H
|
|
|
126 "If t, hard-linked files are marked if the linked-to files were.
|
|
|
127 If a character, those files are always marked with that character.")
|
|
|
128
|
|
|
129 ;;;###autoload
|
|
|
130 (defvar dired-keep-marker-symlink ?Y
|
|
|
131 "If t, symlinked marked files are marked if the linked-to files were.
|
|
|
132 If a character, those files are always marked with that character.")
|
|
|
133
|
|
|
134 ;;;###autoload
|
|
|
135 (defvar dired-dwim-target nil
|
|
|
136 "*If non-nil, dired tries to guess a default target directory:
|
|
|
137 If there is a dired buffer displayed in the next window, use
|
|
|
138 its current subdir, instead of the current subdir of this dired
|
|
|
139 buffer.
|
|
|
140
|
|
|
141 The target is used in the prompt for file copy, move etc.")
|
|
|
142
|
|
|
143 ;;;###autoload
|
|
|
144 (defvar dired-copy-preserve-time nil
|
|
|
145 "*If non-nil, Dired preserves the last-modified time in a file copy.
|
|
|
146 \(This works on only some systems.)\\<dired-mode-map>
|
|
|
147 Use `\\[dired-do-copy]' with a zero prefix argument to toggle its value.")
|
|
|
148
|
|
|
149 ;;; Hook variables
|
|
|
150
|
|
|
151 (defvar dired-load-hook nil
|
|
|
152 "Run after loading dired.
|
|
|
153 You can customize key bindings or load extensions with this.")
|
|
|
154
|
|
|
155 (defvar dired-mode-hook nil
|
|
|
156 "Run at the very end of dired-mode.")
|
|
|
157
|
|
|
158 (defvar dired-before-readin-hook nil
|
|
|
159 "This hook is run before a dired buffer is newly read in (created or reverted).")
|
|
|
160
|
|
|
161 (defvar dired-after-readin-hook nil
|
|
|
162 "After each listing of a file or directory, this hook is run
|
|
|
163 with the buffer narrowed to the listing.")
|
|
|
164 ;; Note this can't simply be run inside function dired-ls as the hook
|
|
|
165 ;; functions probably depend on the dired-subdir-alist to be OK.
|
|
|
166
|
|
|
167 ;;; Internal variables
|
|
|
168
|
|
|
169 (defvar dired-marker-char ?* ; the answer is 42
|
|
|
170 ;; so that you can write things like
|
|
|
171 ;; (let ((dired-marker-char ?X))
|
|
|
172 ;; ;; great code using X markers ...
|
|
|
173 ;; )
|
|
|
174 ;; For example, commands operating on two sets of files, A and B.
|
|
|
175 ;; Or marking files with digits 0-9. This could implicate
|
|
|
176 ;; concentric sets or an order for the marked files.
|
|
|
177 ;; The code depends on dynamic scoping on the marker char.
|
|
|
178 "In dired, character used to mark files for later commands.")
|
|
|
179
|
|
|
180 (defvar dired-del-marker ?D
|
|
|
181 "Character used to flag files for deletion.")
|
|
|
182
|
|
|
183 (defvar dired-shrink-to-fit
|
|
|
184 (if (fboundp 'baud-rate) (> (baud-rate) search-slow-speed) t)
|
|
|
185 "Whether dired shrinks the display buffer to fit the marked files.")
|
|
|
186
|
|
|
187 (defvar dired-flagging-regexp nil);; Last regexp used to flag files.
|
|
|
188
|
|
|
189 (defvar dired-directory nil
|
|
|
190 "The directory name or shell wildcard passed as argument to ls.
|
|
|
191 Local to each dired buffer.")
|
|
|
192
|
|
|
193 (defvar dired-actual-switches nil
|
|
|
194 "The actual (buffer-local) value of `dired-listing-switches'.")
|
|
|
195
|
|
|
196 (defvar dired-re-inode-size "[0-9 \t]*"
|
|
|
197 "Regexp for optional initial inode and file size as produced by ls' -i and -s flags.")
|
|
|
198
|
|
|
199 ;; These regexps must be tested at beginning-of-line, but are also
|
|
|
200 ;; used to search for next matches, so neither omitting "^" nor
|
|
|
201 ;; replacing "^" by "\n" (to make it slightly faster) will work.
|
|
|
202
|
|
|
203 (defvar dired-re-mark "^[^ \n]")
|
|
|
204 ;; "Regexp matching a marked line.
|
|
|
205 ;; Important: the match ends just after the marker."
|
|
|
206 (defvar dired-re-maybe-mark "^. ")
|
|
|
207 ;; Note that dired-re-inode-size allows for an arbitray amount of
|
|
|
208 ;; whitespace, making nested indentation in dired-nstd.el work.
|
|
|
209 (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
|
|
|
210 (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
|
|
|
211 (defvar dired-re-exe;; match ls permission string of an executable file
|
|
|
212 (mapconcat (function
|
|
|
213 (lambda (x)
|
|
|
214 (concat dired-re-maybe-mark dired-re-inode-size x)))
|
|
|
215 '("-[-r][-w][xs][-r][-w].[-r][-w]."
|
|
|
216 "-[-r][-w].[-r][-w][xs][-r][-w]."
|
|
|
217 "-[-r][-w].[-r][-w].[-r][-w][xst]")
|
|
|
218 "\\|"))
|
|
|
219 (defvar dired-re-dot "^.* \\.\\.?/?$") ; with -F, might end in `/'
|
|
|
220
|
|
|
221 (defvar dired-subdir-alist nil
|
|
|
222 "Association list of subdirectories and their buffer positions:
|
|
|
223
|
|
|
224 \((LASTDIR . LASTMARKER) ... (DEFAULT-DIRECTORY . FIRSTMARKER)).")
|
|
|
225
|
|
|
226 (defvar dired-subdir-regexp "^. \\([^ \n\r]+\\)\\(:\\)[\n\r]"
|
|
|
227 "Regexp matching a maybe hidden subdirectory line in ls -lR output.
|
|
|
228 Subexpression 1 is the subdirectory proper, no trailing colon.
|
|
|
229 The match starts at the beginning of the line and ends after the end
|
|
|
230 of the line (\\n or \\r).
|
|
|
231 Subexpression 2 must end right before the \\n or \\r.")
|
|
|
232
|
|
|
233
|
|
|
234 ;;; Macros must be defined before they are used - for the byte compiler.
|
|
|
235
|
|
|
236 ;; Returns the count if any work was done, nil otherwise.
|
|
|
237 (defmacro dired-mark-if (predicate msg)
|
|
|
238 (` (let (buffer-read-only count)
|
|
|
239 (save-excursion
|
|
|
240 (setq count 0)
|
|
|
241 (if (, msg) (message "Marking %ss..." (, msg)))
|
|
|
242 (goto-char (point-min))
|
|
|
243 (while (not (eobp))
|
|
|
244 (if (, predicate)
|
|
|
245 (progn
|
|
|
246 (delete-char 1)
|
|
|
247 (insert dired-marker-char)
|
|
|
248 (setq count (1+ count))))
|
|
|
249 (forward-line 1))
|
|
|
250 (if (, msg) (message "%s %s%s %s%s."
|
|
|
251 count
|
|
|
252 (, msg)
|
|
|
253 (dired-plural-s count)
|
|
|
254 (if (eq dired-marker-char ?\040) "un" "")
|
|
|
255 (if (eq dired-marker-char dired-del-marker)
|
|
|
256 "flagged" "marked"))))
|
|
|
257 (and (> count 0) count))))
|
|
|
258
|
|
|
259 (defmacro dired-mark-map (body arg &optional show-progress)
|
|
|
260 ;; "Macro: Perform BODY with point somewhere on each marked line
|
|
|
261 ;;and return a list of BODY's results.
|
|
|
262 ;;If no marked file could be found, execute BODY on the current line.
|
|
|
263 ;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
|
|
|
264 ;; files instead of the marked files.
|
|
|
265 ;; In that case point is dragged along. This is so that commands on
|
|
|
266 ;; the next ARG (instead of the marked) files can be chained easily.
|
|
|
267 ;; If ARG is otherwise non-nil, use current file instead.
|
|
|
268 ;;If optional third arg SHOW-PROGRESS evaluates to non-nil,
|
|
|
269 ;; redisplay the dired buffer after each file is processed.
|
|
|
270 ;;No guarantee is made about the position on the marked line.
|
|
|
271 ;; BODY must ensure this itself if it depends on this.
|
|
|
272 ;;Search starts at the beginning of the buffer, thus the car of the list
|
|
|
273 ;; corresponds to the line nearest to the buffer's bottom. This
|
|
|
274 ;; is also true for (positive and negative) integer values of ARG.
|
|
|
275 ;;BODY should not be too long as it is expanded four times."
|
|
|
276 ;;
|
|
|
277 ;;Warning: BODY must not add new lines before point - this may cause an
|
|
|
278 ;;endless loop.
|
|
|
279 ;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
|
|
|
280 (` (prog1
|
|
|
281 (let (buffer-read-only case-fold-search found results)
|
|
|
282 (if (, arg)
|
|
|
283 (if (integerp (, arg))
|
|
|
284 (progn;; no save-excursion, want to move point.
|
|
|
285 (dired-repeat-over-lines
|
|
|
286 (, arg)
|
|
|
287 (function (lambda ()
|
|
|
288 (if (, show-progress) (sit-for 0))
|
|
|
289 (setq results (cons (, body) results)))))
|
|
|
290 (if (< (, arg) 0)
|
|
|
291 (nreverse results)
|
|
|
292 results))
|
|
|
293 ;; non-nil, non-integer ARG means use current file:
|
|
|
294 (list (, body)))
|
|
|
295 (let ((regexp (dired-marker-regexp)) next-position)
|
|
|
296 (save-excursion
|
|
|
297 (goto-char (point-min))
|
|
|
298 ;; remember position of next marked file before BODY
|
|
|
299 ;; can insert lines before the just found file,
|
|
|
300 ;; confusing us by finding the same marked file again
|
|
|
301 ;; and again and...
|
|
|
302 (setq next-position (and (re-search-forward regexp nil t)
|
|
|
303 (point-marker))
|
|
|
304 found (not (null next-position)))
|
|
|
305 (while next-position
|
|
|
306 (goto-char next-position)
|
|
|
307 (if (, show-progress) (sit-for 0))
|
|
|
308 (setq results (cons (, body) results))
|
|
|
309 ;; move after last match
|
|
|
310 (goto-char next-position)
|
|
|
311 (forward-line 1)
|
|
|
312 (set-marker next-position nil)
|
|
|
313 (setq next-position (and (re-search-forward regexp nil t)
|
|
|
314 (point-marker)))))
|
|
|
315 (if found
|
|
|
316 results
|
|
|
317 (list (, body))))))
|
|
|
318 ;; save-excursion loses, again
|
|
|
319 (dired-move-to-filename))))
|
|
|
320
|
|
|
321 (defun dired-mark-get-files (&optional localp arg)
|
|
|
322 "Return the marked files as list of strings.
|
|
|
323 The list is in the same order as the buffer, that is, the car is the
|
|
|
324 first marked file.
|
|
|
325 Values returned are normally absolute pathnames.
|
|
|
326 Optional arg LOCALP as in `dired-get-filename'.
|
|
|
327 Optional second argument ARG forces to use other files. If ARG is an
|
|
|
328 integer, use the next ARG files. If ARG is otherwise non-nil, use
|
|
|
329 current file. Usually ARG comes from the current prefix arg."
|
|
|
330 (nreverse (save-excursion (dired-mark-map (dired-get-filename localp) arg))))
|
|
|
331
|
|
|
332
|
|
|
333 ;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
|
|
|
334 ;; other special applications.
|
|
|
335
|
|
|
336 ;; dired-ls
|
|
|
337 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
|
|
|
338 ;; FULL-DIRECTORY-P is nil.
|
|
|
339 ;; The single line of output must display FILE's name as it was
|
|
|
340 ;; given, namely, an absolute path name.
|
|
|
341 ;; - must insert exactly one line for each file if WILDCARD or
|
|
|
342 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
|
|
|
343 ;; before the file lines, plus optional text after the file lines.
|
|
|
344 ;; Lines are delimited by "\n", so filenames containing "\n" are not
|
|
|
345 ;; allowed.
|
|
|
346 ;; File lines should display the basename, not a path name.
|
|
|
347 ;; - must drag point after inserted text
|
|
|
348 ;; - must be consistent with
|
|
|
349 ;; - functions dired-move-to-filename, (these two define what a file line is)
|
|
|
350 ;; dired-move-to-end-of-filename,
|
|
|
351 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
|
|
|
352 ;; dired-insert-headerline
|
|
|
353 ;; dired-after-subdir-garbage (defines what a "total" line is)
|
|
|
354 ;; - variables dired-subdir-regexp
|
|
|
355 (defun dired-ls (file switches &optional wildcard full-directory-p)
|
|
|
356 ; "Insert ls output of FILE, formatted according to SWITCHES.
|
|
|
357 ;Optional third arg WILDCARD means treat FILE as shell wildcard.
|
|
|
358 ;Optional fourth arg FULL-DIRECTORY-P means file is a directory and
|
|
|
359 ;switches do not contain `d', so that a full listing is expected.
|
|
|
360 ;
|
|
|
361 ;Uses dired-ls-program (and shell-file-name if WILDCARD) to do the work."
|
|
|
362 (if wildcard
|
|
|
363 (let ((default-directory (file-name-directory file)))
|
|
|
364 (call-process shell-file-name nil t nil
|
|
|
365 "-c" (concat dired-ls-program " -d " switches " "
|
|
|
366 (file-name-nondirectory file))))
|
|
|
367 (call-process dired-ls-program nil t nil switches file)))
|
|
|
368
|
|
|
369 ;; The dired command
|
|
|
370
|
|
|
371 (defun dired-read-dir-and-switches (str)
|
|
|
372 ;; For use in interactive.
|
|
|
373 (reverse (list
|
|
|
374 (if current-prefix-arg
|
|
|
375 (read-string "Dired listing switches: "
|
|
|
376 dired-listing-switches))
|
|
|
377 (read-file-name (format "Dired %s(directory): " str)
|
|
|
378 nil default-directory nil))))
|
|
|
379
|
|
|
380 ;;;###autoload (define-key ctl-x-map "d" 'dired)
|
|
|
381 ;;;###autoload
|
|
|
382 (defun dired (dirname &optional switches)
|
|
|
383 "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
|
|
|
384 With an optional prefix argument you can specify the ls SWITCHES that are used.
|
|
|
385 Dired displays a list of files in DIRNAME (which may also have
|
|
|
386 shell wildcards appended to select certain files).
|
|
|
387 You can move around in it with the usual commands.
|
|
|
388 You can flag files for deletion with \\<dired-mode-map>\\[dired-flag-file-deleted] and then delete them by
|
|
|
389 typing \\[dired-do-deletions].
|
|
|
390 Type \\[describe-mode] after entering dired for more info.
|
|
|
391
|
|
|
392 If DIRNAME is already in a dired buffer, that buffer is used without refresh."
|
|
|
393 ;; Cannot use (interactive "D") because of wildcards.
|
|
|
394 (interactive (dired-read-dir-and-switches ""))
|
|
|
395 (switch-to-buffer (dired-noselect dirname switches)))
|
|
|
396
|
|
|
397 ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
|
|
|
398 ;;;###autoload
|
|
|
399 (defun dired-other-window (dirname &optional switches)
|
|
|
400 "\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
|
|
|
401 (interactive (dired-read-dir-and-switches "in other window "))
|
|
|
402 (switch-to-buffer-other-window (dired-noselect dirname switches)))
|
|
|
403
|
|
|
404 ;;;###autoload
|
|
|
405 (defun dired-noselect (dirname &optional switches)
|
|
|
406 "Like `dired' but returns the dired buffer as value, does not select it."
|
|
|
407 (or dirname (setq dirname default-directory))
|
|
|
408 ;; This loses the distinction between "/foo/*/" and "/foo/*" that
|
|
|
409 ;; some shells make:
|
|
|
410 (setq dirname (expand-file-name (directory-file-name dirname)))
|
|
|
411 (if (file-directory-p dirname)
|
|
|
412 (setq dirname (file-name-as-directory dirname)))
|
|
|
413 (dired-internal-noselect dirname switches))
|
|
|
414
|
|
|
415 ;; Separate function from dired-noselect for the sake of dired-vms.el.
|
|
|
416 (defun dired-internal-noselect (dirname &optional switches)
|
|
|
417 ;; If there is an existing dired buffer for DIRNAME, just leave
|
|
|
418 ;; buffer as it is (don't even call dired-revert).
|
|
|
419 ;; This saves time especially for deep trees or with ange-ftp.
|
|
|
420 ;; The user can type `g'easily, and it is more consistent with find-file.
|
|
|
421 ;; But if SWITCHES are given they are probably different from the
|
|
|
422 ;; buffer's old value, so call dired-sort-other, which does
|
|
|
423 ;; revert the buffer.
|
|
|
424 ;; A pity we can't possibly do "Directory has changed - refresh? "
|
|
|
425 ;; like find-file does...maybe in the GNU OS.
|
|
|
426 (let* ((buffer (dired-find-buffer-nocreate dirname))
|
|
|
427 ;; note that buffer already is in dired-mode, if found
|
|
|
428 (new-buffer-p (not buffer))
|
|
|
429 (old-buf (current-buffer)))
|
|
|
430 (or buffer
|
|
|
431 (let ((default-major-mode 'fundamental-mode))
|
|
|
432 ;; We don't want default-major-mode to run hooks and set auto-fill
|
|
|
433 ;; or whatever, now that dired-mode does not
|
|
|
434 ;; kill-all-local-variables any longer.
|
|
|
435 (setq buffer (create-file-buffer (directory-file-name dirname)))))
|
|
|
436 (set-buffer buffer)
|
|
|
437 (if (not new-buffer-p) ; existing buffer ...
|
|
|
438 (if switches ; ... but new switches
|
|
|
439 (dired-sort-other switches)) ; this calls dired-revert
|
|
|
440 ;; Else a new buffer
|
|
|
441 (setq default-directory (if (file-directory-p dirname)
|
|
|
442 dirname
|
|
|
443 (file-name-directory dirname)))
|
|
|
444 (or switches (setq switches dired-listing-switches))
|
|
|
445 (dired-mode dirname switches)
|
|
|
446 ;; default-directory and dired-actual-switches are set now
|
|
|
447 ;; (buffer-local), so we can call dired-readin:
|
|
|
448 (let ((failed t))
|
|
|
449 (unwind-protect
|
|
|
450 (progn (dired-readin dirname buffer)
|
|
|
451 (setq failed nil))
|
|
|
452 ;; dired-readin can fail if parent directories are inaccessible.
|
|
|
453 ;; Don't leave an empty buffer around in that case.
|
|
|
454 (if failed (kill-buffer buffer))))
|
|
|
455 ;; No need to narrow since the whole buffer contains just
|
|
|
456 ;; dired-readin's output, nothing else. The hook can
|
|
|
457 ;; successfully use dired functions (e.g. dired-get-filename)
|
|
|
458 ;; as the subdir-alist has been built in dired-readin.
|
|
|
459 (run-hooks 'dired-after-readin-hook)
|
|
|
460 (goto-char (point-min))
|
|
|
461 (dired-initial-position dirname))
|
|
|
462 (set-buffer old-buf)
|
|
|
463 buffer))
|
|
|
464
|
|
|
465 ;; This differs from dired-buffers-for-dir in that it does not consider
|
|
|
466 ;; subdirs of default-directory and searches for the first match only
|
|
|
467 (defun dired-find-buffer-nocreate (dirname)
|
|
|
468 (let (found (blist (buffer-list)))
|
|
|
469 (while blist
|
|
|
470 (save-excursion
|
|
|
471 (set-buffer (car blist))
|
|
|
472 (if (and (eq major-mode 'dired-mode)
|
|
|
473 (equal dired-directory dirname))
|
|
|
474 (setq found (car blist)
|
|
|
475 blist nil)
|
|
|
476 (setq blist (cdr blist)))))
|
|
|
477 found))
|
|
|
478
|
|
|
479
|
|
|
480 ;; Read in a new dired buffer
|
|
|
481
|
|
|
482 ;; dired-readin differs from dired-insert-subdir in that it accepts
|
|
|
483 ;; wildcards, erases the buffer, and builds the subdir-alist anew
|
|
|
484 ;; (including making it buffer-local and clearing it first).
|
|
|
485 (defun dired-readin (dirname buffer)
|
|
|
486 ;; default-directory and dired-actual-switches must be buffer-local
|
|
|
487 ;; and initialized by now.
|
|
|
488 ;; Thus we can test (equal default-directory dirname) instead of
|
|
|
489 ;; (file-directory-p dirname) and save a filesystem transaction.
|
|
|
490 ;; Also, we can run this hook which may want to modify the switches
|
|
|
491 ;; based on default-directory, e.g. with ange-ftp to a SysV host
|
|
|
492 ;; where ls won't understand -Al switches.
|
|
|
493 (setq dirname (expand-file-name dirname))
|
|
|
494 (run-hooks 'dired-before-readin-hook)
|
|
|
495 (save-excursion
|
|
|
496 (message "Reading directory %s..." dirname)
|
|
|
497 (set-buffer buffer)
|
|
|
498 (let (buffer-read-only)
|
|
|
499 (widen)
|
|
|
500 (erase-buffer)
|
|
|
501 (dired-readin-insert dirname)
|
|
|
502 (dired-indent-rigidly (point-min) (point-max) 2)
|
|
|
503 ;; We need this to make the root dir have a header line as all
|
|
|
504 ;; other subdirs have:
|
|
|
505 (goto-char (point-min))
|
|
|
506 (dired-insert-headerline default-directory)
|
|
|
507 ;; can't run dired-after-readin-hook here, it may depend on the subdir
|
|
|
508 ;; alist to be OK.
|
|
|
509 )
|
|
|
510 (message "Reading directory %s...done" dirname)
|
|
|
511 (set-buffer-modified-p nil)
|
|
|
512 ;; Must first make alist buffer local and set it to nil because
|
|
|
513 ;; dired-build-subdir-alist will call dired-clear-alist first
|
|
|
514 (set (make-local-variable 'dired-subdir-alist) nil)
|
|
|
515 (let (case-fold-search)
|
|
|
516 (if (string-match "R" dired-actual-switches)
|
|
|
517 (dired-build-subdir-alist)
|
|
|
518 ;; no need to parse the buffer if listing is not recursive
|
|
|
519 (dired-simple-subdir-alist)))))
|
|
|
520
|
|
|
521 ;; Subroutines of dired-readin
|
|
|
522
|
|
|
523 (defun dired-readin-insert (dirname)
|
|
|
524 ;; Just insert listing for DIRNAME, assuming a clean buffer.
|
|
|
525 (let ((font-lock-mode nil))
|
|
|
526 (if (equal default-directory dirname);; i.e., (file-directory-p dirname)
|
|
|
527 (dired-ls (if (or (let (case-fold-search)
|
|
|
528 (string-match "R" dired-actual-switches))
|
|
|
529 (eq system-type 'vax-vms))
|
|
|
530 dirname
|
|
|
531 ;; On SysV derived system, symbolic links to
|
|
|
532 ;; directories are not resolved, while on BSD
|
|
|
533 ;; derived it suffices to let DIRNAME end in slash.
|
|
|
534 ;; We always let it end in "/." since it does no
|
|
|
535 ;; harm on BSD and makes Dired work on such links on
|
|
|
536 ;; SysV.
|
|
|
537 ;; Cannot do this with -R since "dir/./subdir"
|
|
|
538 ;; headerlines would result, utterly confusing dired.
|
|
|
539 (concat dirname "."))
|
|
|
540 dired-actual-switches nil t)
|
|
|
541 (if (not (file-readable-p
|
|
|
542 (directory-file-name (file-name-directory dirname))))
|
|
|
543 (error "Directory %s inaccessible or nonexistent" dirname)
|
|
|
544 ;; else assume it contains wildcards:
|
|
|
545 (dired-ls dirname dired-actual-switches t)
|
|
|
546 (save-excursion;; insert wildcard instead of total line:
|
|
|
547 (goto-char (point-min))
|
|
|
548 (insert "wildcard " (file-name-nondirectory dirname) "\n"))))))
|
|
|
549
|
|
|
550 (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
|
|
|
551 ;; Insert DIR's headerline with no trailing slash, exactly like ls
|
|
|
552 ;; would, and put cursor where dired-build-subdir-alist puts subdir
|
|
|
553 ;; boundaries.
|
|
|
554 (save-excursion (insert " " (directory-file-name dir) ":\n")))
|
|
|
555
|
|
|
556 ;; Make the file names highlight when the mouse is on them.
|
|
|
557 ;; from FSF 19.30.
|
|
|
558 (defun dired-insert-set-properties (beg end)
|
|
|
559 (save-excursion
|
|
|
560 (goto-char beg)
|
|
|
561 (while (< (point) end)
|
|
|
562 (condition-case nil
|
|
|
563 (if (dired-move-to-filename)
|
|
|
564 (put-text-property (point)
|
|
|
565 (save-excursion
|
|
|
566 (dired-move-to-end-of-filename)
|
|
|
567 (point))
|
|
|
568 'highlight t))
|
|
|
569 (error nil))
|
|
|
570 (forward-line 1))))
|
|
|
571
|
|
|
572
|
|
|
573 ;; Reverting a dired buffer
|
|
|
574
|
|
|
575 (defun dired-revert (&optional arg noconfirm)
|
|
|
576 ;; Reread the dired buffer. Must also be called after
|
|
|
577 ;; dired-actual-switches have changed.
|
|
|
578 ;; Should not fail even on completely garbaged buffers.
|
|
|
579 ;; Preserves old cursor, marks/flags, hidden-p.
|
|
|
580 (widen) ; just in case user narrowed
|
|
|
581 (let ((opoint (point))
|
|
|
582 (ofile (dired-get-filename nil t))
|
|
|
583 (mark-alist nil) ; save marked files
|
|
|
584 (hidden-subdirs (dired-remember-hidden))
|
|
|
585 (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
|
|
|
586 case-fold-search ; we check for upper case ls flags
|
|
|
587 buffer-read-only)
|
|
|
588 (goto-char (point-min))
|
|
|
589 (setq mark-alist;; only after dired-remember-hidden since this unhides:
|
|
|
590 (dired-remember-marks (point-min) (point-max)))
|
|
|
591 ;; treat top level dir extra (it may contain wildcards)
|
|
|
592 (dired-readin dired-directory (current-buffer))
|
|
|
593 (let ((dired-after-readin-hook nil))
|
|
|
594 ;; don't run that hook for each subdir...
|
|
|
595 (dired-insert-old-subdirs old-subdir-alist))
|
|
|
596 (dired-mark-remembered mark-alist) ; mark files that were marked
|
|
|
597 ;; ... run the hook for the whole buffer, and only after markers
|
|
|
598 ;; have been reinserted (else omitting in dired-x would omit marked files)
|
|
|
599 (run-hooks 'dired-after-readin-hook) ; no need to narrow
|
|
|
600 (or (and ofile (dired-goto-file ofile)) ; move cursor to where it
|
|
|
601 (goto-char opoint)) ; was before
|
|
|
602 (dired-move-to-filename)
|
|
|
603 (save-excursion ; hide subdirs that were hidden
|
|
|
604 (mapcar (function (lambda (dir)
|
|
|
605 (if (dired-goto-subdir dir)
|
|
|
606 (dired-hide-subdir 1))))
|
|
|
607 hidden-subdirs)))
|
|
|
608 ;; outside of the let scope
|
|
|
609 (setq buffer-read-only t))
|
|
|
610
|
|
|
611 ;; Subroutines of dired-revert
|
|
|
612 ;; Some of these are also used when inserting subdirs.
|
|
|
613
|
|
|
614 (defun dired-remember-marks (beg end)
|
|
|
615 ;; Return alist of files and their marks, from BEG to END.
|
|
|
616 (if selective-display ; must unhide to make this work.
|
|
|
617 (let (buffer-read-only)
|
|
|
618 (subst-char-in-region beg end ?\r ?\n)))
|
|
|
619 (let (fil chr alist)
|
|
|
620 (save-excursion
|
|
|
621 (goto-char beg)
|
|
|
622 (while (re-search-forward dired-re-mark end t)
|
|
|
623 (if (setq fil (dired-get-filename nil t))
|
|
|
624 (setq chr (preceding-char)
|
|
|
625 alist (cons (cons fil chr) alist)))))
|
|
|
626 alist))
|
|
|
627
|
|
|
628 (defun dired-mark-remembered (alist)
|
|
|
629 ;; Mark all files remembered in ALIST.
|
|
|
630 (let (elt fil chr)
|
|
|
631 (while alist
|
|
|
632 (setq elt (car alist)
|
|
|
633 alist (cdr alist)
|
|
|
634 fil (car elt)
|
|
|
635 chr (cdr elt))
|
|
|
636 (if (dired-goto-file fil)
|
|
|
637 (save-excursion
|
|
|
638 (beginning-of-line)
|
|
|
639 (delete-char 1)
|
|
|
640 (insert chr))))))
|
|
|
641
|
|
|
642 (defun dired-remember-hidden ()
|
|
|
643 (let ((l dired-subdir-alist) dir result)
|
|
|
644 (while l
|
|
|
645 (setq dir (car (car l))
|
|
|
646 l (cdr l))
|
|
|
647 (if (dired-subdir-hidden-p dir)
|
|
|
648 (setq result (cons dir result))))
|
|
|
649 result))
|
|
|
650
|
|
|
651 (defun dired-insert-old-subdirs (old-subdir-alist)
|
|
|
652 ;; Try to insert all subdirs that were displayed before
|
|
|
653 (or (string-match "R" dired-actual-switches)
|
|
|
654 (let (elt dir)
|
|
|
655 (while old-subdir-alist
|
|
|
656 (setq elt (car old-subdir-alist)
|
|
|
657 old-subdir-alist (cdr old-subdir-alist)
|
|
|
658 dir (car elt))
|
|
|
659 (condition-case ()
|
|
|
660 (dired-insert-subdir dir)
|
|
|
661 (error nil))))))
|
|
|
662
|
|
|
663
|
|
|
664 ;; dired mode key bindings and initialization
|
|
|
665
|
|
|
666 (defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
|
|
|
667 (if dired-mode-map
|
|
|
668 nil
|
|
|
669 ;; Force `f' rather than `e' in the mode doc:
|
|
|
670 (fset 'dired-advertised-find-file 'dired-find-file)
|
|
|
671 ;; This looks ugly when substitute-command-keys uses C-d instead d:
|
|
|
672 ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
|
|
|
673
|
|
|
674 (setq dired-mode-map (make-keymap))
|
|
|
675 (suppress-keymap dired-mode-map)
|
|
|
676 ;; Commands to mark certain categories of files
|
|
|
677 (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
|
|
|
678 (define-key dired-mode-map "*" 'dired-mark-executables)
|
|
|
679 (define-key dired-mode-map "." 'dired-clean-directory)
|
|
|
680 (define-key dired-mode-map "/" 'dired-mark-directories)
|
|
|
681 (define-key dired-mode-map "@" 'dired-mark-symlinks)
|
|
|
682 ;; Upper case keys (except !, c, r) for operating on the marked files
|
|
|
683 (define-key dired-mode-map "c" 'dired-do-copy)
|
|
|
684 (define-key dired-mode-map "r" 'dired-do-move)
|
|
|
685 (define-key dired-mode-map "!" 'dired-do-shell-command)
|
|
|
686 (define-key dired-mode-map "B" 'dired-do-byte-compile)
|
|
|
687 (define-key dired-mode-map "C" 'dired-do-compress)
|
|
|
688 (define-key dired-mode-map "G" 'dired-do-chgrp)
|
|
|
689 (define-key dired-mode-map "H" 'dired-do-hardlink)
|
|
|
690 (define-key dired-mode-map "L" 'dired-do-load)
|
|
|
691 (define-key dired-mode-map "M" 'dired-do-chmod)
|
|
|
692 (define-key dired-mode-map "O" 'dired-do-chown)
|
|
|
693 (define-key dired-mode-map "P" 'dired-do-print)
|
|
|
694 (define-key dired-mode-map "U" 'dired-do-uncompress)
|
|
|
695 (define-key dired-mode-map "X" 'dired-do-delete)
|
|
|
696 (define-key dired-mode-map "Y" 'dired-do-symlink)
|
|
|
697 ;; exceptions to the upper key rule
|
|
|
698 (define-key dired-mode-map "D" 'dired-diff)
|
|
|
699 (define-key dired-mode-map "W" 'dired-why)
|
|
|
700 ;; Tree Dired commands
|
|
|
701 (define-key dired-mode-map "\M-\C-?" 'dired-unflag-all-files)
|
|
|
702 (define-key dired-mode-map "\M-\C-d" 'dired-tree-down)
|
|
|
703 (define-key dired-mode-map "\M-\C-u" 'dired-tree-up)
|
|
|
704 (define-key dired-mode-map "\M-\C-n" 'dired-next-subdir)
|
|
|
705 (define-key dired-mode-map "\M-\C-p" 'dired-prev-subdir)
|
|
|
706 ;; move to marked files
|
|
|
707 (define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
|
|
|
708 (define-key dired-mode-map "\M-}" 'dired-next-marked-file)
|
|
|
709 ;; kill marked files
|
|
|
710 (define-key dired-mode-map "\M-k" 'dired-do-kill)
|
|
|
711 ;; Make all regexp commands share a `%' prefix:
|
|
|
712 (fset 'dired-regexp-prefix (make-sparse-keymap))
|
|
|
713 (define-key dired-mode-map "%" 'dired-regexp-prefix)
|
|
|
714 (define-key dired-mode-map "%u" 'dired-upcase)
|
|
|
715 (define-key dired-mode-map "%l" 'dired-downcase)
|
|
|
716 (define-key dired-mode-map "%d" 'dired-flag-regexp-files)
|
|
|
717 (define-key dired-mode-map "%m" 'dired-mark-files-regexp)
|
|
|
718 (define-key dired-mode-map "%r" 'dired-do-rename-regexp)
|
|
|
719 (define-key dired-mode-map "%c" 'dired-do-copy-regexp)
|
|
|
720 (define-key dired-mode-map "%H" 'dired-do-hardlink-regexp)
|
|
|
721 (define-key dired-mode-map "%Y" 'dired-do-symlink-regexp)
|
|
|
722 ;; Lower keys for commands not operating on all the marked files
|
|
|
723 (define-key dired-mode-map "d" 'dired-flag-file-deleted)
|
|
|
724 (define-key dired-mode-map "e" 'dired-find-file)
|
|
|
725 (define-key dired-mode-map "f" 'dired-advertised-find-file)
|
|
|
726 (define-key dired-mode-map "g" 'revert-buffer)
|
|
|
727 (define-key dired-mode-map "h" 'describe-mode)
|
|
|
728 (define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
|
|
|
729 (define-key dired-mode-map "k" 'dired-kill-line-or-subdir)
|
|
|
730 (define-key dired-mode-map "l" 'dired-do-redisplay)
|
|
|
731 (define-key dired-mode-map "m" 'dired-mark-subdir-or-file)
|
|
|
732 (define-key dired-mode-map "n" 'dired-next-line)
|
|
|
733 (define-key dired-mode-map "o" 'dired-find-file-other-window)
|
|
|
734 (define-key dired-mode-map "p" 'dired-previous-line)
|
|
|
735 (define-key dired-mode-map "q" 'dired-quit)
|
|
|
736 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit)
|
|
|
737 (define-key dired-mode-map "u" 'dired-unmark-subdir-or-file)
|
|
|
738 (define-key dired-mode-map "v" 'dired-view-file)
|
|
|
739 (define-key dired-mode-map "x" 'dired-do-deletions)
|
|
|
740 (define-key dired-mode-map "~" 'dired-flag-backup-files)
|
|
|
741 (define-key dired-mode-map "\M-~" 'dired-backup-diff)
|
|
|
742 (define-key dired-mode-map "+" 'dired-create-directory)
|
|
|
743 ;; moving
|
|
|
744 (define-key dired-mode-map "<" 'dired-prev-dirline)
|
|
|
745 (define-key dired-mode-map ">" 'dired-next-dirline)
|
|
|
746 (define-key dired-mode-map "^" 'dired-up-directory)
|
|
|
747 (define-key dired-mode-map " " 'dired-next-line)
|
|
|
748 (define-key dired-mode-map "\C-n" 'dired-next-line)
|
|
|
749 (define-key dired-mode-map "\C-p" 'dired-previous-line)
|
|
|
750 ;; hiding
|
|
|
751 (define-key dired-mode-map "$" 'dired-hide-subdir)
|
|
|
752 (define-key dired-mode-map "=" 'dired-hide-all)
|
|
|
753 ;; misc
|
|
|
754 (define-key dired-mode-map "?" 'dired-summary)
|
|
|
755 (define-key dired-mode-map "\177" 'dired-backup-unflag)
|
|
|
756 (define-key dired-mode-map "\C-_" 'dired-undo)
|
|
|
757 (define-key dired-mode-map "\C-xu" 'dired-undo)
|
|
|
758 )
|
|
|
759
|
|
|
760 (or (equal (assq 'dired-sort-mode minor-mode-alist)
|
|
|
761 '(dired-sort-mode dired-sort-mode))
|
|
|
762 ;; Test whether this has already been done in case dired is reloaded
|
|
|
763 ;; There may be several elements with dired-sort-mode as car.
|
|
|
764 (setq minor-mode-alist
|
|
|
765 (cons '(dired-sort-mode dired-sort-mode)
|
|
|
766 ;; dired-sort-mode is nil outside dired
|
|
|
767 minor-mode-alist)))
|
|
|
768
|
|
|
769 ;; Dired mode is suitable only for specially formatted data.
|
|
|
770 (put 'dired-mode 'mode-class 'special)
|
|
|
771
|
|
|
772 (defun dired-mode (&optional dirname switches)
|
|
|
773 "\
|
|
|
774 Mode for \"editing\" directory listings.
|
|
|
775 In dired, you are \"editing\" a list of the files in a directory and
|
|
|
776 \(optionally) its subdirectories, in the format of `ls -lR'.
|
|
|
777 Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
|
|
|
778 \"Editing\" means that you can run shell commands on files, visit,
|
|
|
779 compress, load or byte-compile them, change their file attributes
|
|
|
780 and insert subdirectories into the same buffer. You can \"mark\"
|
|
|
781 files for later commands or \"flag\" them for deletion, either file
|
|
|
782 by file or all files matching certain criteria.
|
|
|
783 You can move using the usual cursor motion commands.\\<dired-mode-map>
|
|
|
784 Letters no longer insert themselves. Digits are prefix arguments.
|
|
|
785 Instead, type \\[dired-flag-file-deleted] to flag a file for Deletion.
|
|
|
786 Type \\[dired-mark-subdir-or-file] to Mark a file or subdirectory for later commands.
|
|
|
787 Most commands operate on the marked files and use the current file
|
|
|
788 if no files are marked. Use a numeric prefix argument to operate on
|
|
|
789 the next ARG (or previous -ARG if ARG<0) files, or just `1'
|
|
|
790 to operate on the current file only. Prefix arguments override marks.
|
|
|
791 Mark-using commands display a list of failures afterwards. Type \\[dired-why] to see
|
|
|
792 why something went wrong.
|
|
|
793 Type \\[dired-unmark-subdir-or-file] to Unmark a file or all files of a subdirectory.
|
|
|
794 Type \\[dired-backup-unflag] to back up one line and unflag.
|
|
|
795 Type \\[dired-do-deletions] to eXecute the deletions requested.
|
|
|
796 Type \\[dired-advertised-find-file] to Find the current line's file
|
|
|
797 (or dired it in another buffer, if it is a directory).
|
|
|
798 Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
|
|
|
799 Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
|
|
|
800 Type \\[dired-do-move] to Rename a file or move the marked files to another directory.
|
|
|
801 Type \\[dired-do-copy] to Copy files.
|
|
|
802 Type \\[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the ls switches.
|
|
|
803 Type \\[revert-buffer] to read all currently expanded directories again.
|
|
|
804 This retains all marks and hides subdirs again that were hidden before.
|
|
|
805 SPC and DEL can be used to move down and up by lines.
|
|
|
806
|
|
|
807 If dired ever gets confused, you can either type \\[revert-buffer] \
|
|
|
808 to read the
|
|
|
809 directories again, type \\[dired-do-redisplay] \
|
|
|
810 to relist a single or the marked files or a
|
|
|
811 subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
|
|
|
812 again for the directory tree.
|
|
|
813
|
|
|
814 Customization variables (rename this buffer and type \\[describe-variable] on each line
|
|
|
815 for more info):
|
|
|
816
|
|
|
817 dired-listing-switches
|
|
|
818 dired-trivial-filenames
|
|
|
819 dired-shrink-to-fit
|
|
|
820 dired-marker-char
|
|
|
821 dired-del-marker
|
|
|
822 dired-keep-marker-move
|
|
|
823 dired-keep-marker-copy
|
|
|
824 dired-keep-marker-hardlink
|
|
|
825 dired-keep-marker-symlink
|
|
|
826
|
|
|
827 Hooks (use \\[describe-variable] to see their documentation):
|
|
|
828
|
|
|
829 dired-before-readin-hook
|
|
|
830 dired-after-readin-hook
|
|
|
831 dired-mode-hook
|
|
|
832 dired-load-hook
|
|
|
833
|
|
|
834 Keybindings:
|
|
|
835 \\{dired-mode-map}"
|
|
|
836 ;; Not to be called interactively (e.g. dired-directory will be set
|
|
|
837 ;; to default-directory, which is wrong with wildcards).
|
|
|
838 (kill-all-local-variables)
|
|
|
839 (use-local-map dired-mode-map)
|
|
|
840 (dired-advertise) ; default-directory is already set
|
|
|
841 (setq major-mode 'dired-mode
|
|
|
842 mode-name "Dired"
|
|
|
843 case-fold-search nil
|
|
|
844 buffer-read-only t
|
|
|
845 selective-display t ; for subdirectory hiding
|
|
|
846 modeline-buffer-identification '("Dired: %17b"))
|
|
|
847 (set (make-local-variable 'revert-buffer-function)
|
|
|
848 (function dired-revert))
|
|
|
849 (set (make-local-variable 'page-delimiter)
|
|
|
850 "\n\n")
|
|
|
851 (set (make-local-variable 'dired-directory)
|
|
|
852 (or dirname default-directory))
|
|
|
853 (set (make-local-variable 'list-buffers-directory)
|
|
|
854 dired-directory)
|
|
|
855 (set (make-local-variable 'dired-actual-switches)
|
|
|
856 (or switches dired-listing-switches))
|
|
|
857 (make-local-variable 'dired-sort-mode)
|
|
|
858 (dired-sort-other dired-actual-switches t)
|
|
|
859 (run-hooks 'dired-mode-hook))
|
|
|
860
|
|
|
861
|
|
|
862 (defun dired-check-ls-l ()
|
|
|
863 (let (case-fold-search)
|
|
|
864 (or (string-match "l" dired-actual-switches)
|
|
|
865 (error "Dired needs -l in ls switches"))))
|
|
|
866
|
|
|
867 (defun dired-repeat-over-lines (arg function)
|
|
|
868 ;; This version skips non-file lines.
|
|
|
869 (beginning-of-line)
|
|
|
870 (while (and (> arg 0) (not (eobp)))
|
|
|
871 (setq arg (1- arg))
|
|
|
872 (beginning-of-line)
|
|
|
873 (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
|
|
|
874 (save-excursion (funcall function))
|
|
|
875 (forward-line 1))
|
|
|
876 (while (and (< arg 0) (not (bobp)))
|
|
|
877 (setq arg (1+ arg))
|
|
|
878 (forward-line -1)
|
|
|
879 (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
|
|
|
880 (beginning-of-line)
|
|
|
881 (save-excursion (funcall function))
|
|
|
882 (dired-move-to-filename))
|
|
|
883 (dired-move-to-filename))
|
|
|
884
|
|
|
885 (defun dired-flag-file-deleted (arg)
|
|
|
886 "In dired, flag the current line's file for deletion.
|
|
|
887 With prefix arg, repeat over several lines.
|
|
|
888
|
|
|
889 If on a subdir headerline, mark all its files except `.' and `..'."
|
|
|
890 (interactive "P")
|
|
|
891 (let ((dired-marker-char dired-del-marker))
|
|
|
892 (dired-mark-subdir-or-file arg)))
|
|
|
893
|
|
|
894 (defun dired-quit ()
|
|
|
895 "Bury the current dired buffer."
|
|
|
896 (interactive)
|
|
|
897 (bury-buffer))
|
|
|
898
|
|
|
899 (defun dired-summary ()
|
|
|
900 (interactive)
|
|
|
901 ;>> this should check the key-bindings and use substitute-command-keys if non-standard
|
|
|
902 (message
|
|
|
903 "d-elete, u-ndelete, x-punge, f-ind, o-ther window, r-ename, c-opy, h-elp"))
|
|
|
904
|
|
|
905 (defun dired-create-directory (directory)
|
|
|
906 "Create a directory called DIRECTORY."
|
|
|
907 (interactive
|
|
|
908 (list (read-file-name "Create directory: " (dired-current-directory))))
|
|
|
909 (let ((expanded (directory-file-name (expand-file-name directory))))
|
|
|
910 (make-directory expanded)
|
|
|
911 (dired-add-file expanded)
|
|
|
912 (dired-move-to-filename)))
|
|
|
913
|
|
|
914 (defun dired-undo ()
|
|
|
915 "Undo in a dired buffer.
|
|
|
916 This doesn't recover lost files, it is just normal undo with temporarily
|
|
|
917 writeable buffer. You can use it to recover marks, killed lines or subdirs.
|
|
|
918 In the latter case, you have to do \\[dired-build-subdir-alist] to
|
|
|
919 parse the buffer again."
|
|
|
920 (interactive)
|
|
|
921 (let (buffer-read-only)
|
|
|
922 (undo)))
|
|
|
923
|
|
|
924 (defun dired-unflag (arg)
|
|
|
925 "In dired, remove the current line's delete flag then move to next line.
|
|
|
926 Optional prefix ARG says how many lines to unflag."
|
|
|
927 (interactive "p")
|
|
|
928 (dired-repeat-over-lines arg
|
|
|
929 '(lambda ()
|
|
|
930 (let (buffer-read-only)
|
|
|
931 (delete-char 1)
|
|
|
932 (insert " ")
|
|
|
933 (forward-char -1)
|
|
|
934 nil))))
|
|
|
935
|
|
|
936 (defun dired-backup-unflag (arg)
|
|
|
937 "In dired, move up lines and remove deletion flag there.
|
|
|
938 Optional prefix ARG says how many lines to unflag; default is one line."
|
|
|
939 (interactive "p")
|
|
|
940 (dired-unflag (- arg)))
|
|
|
941
|
|
|
942 (defun dired-next-line (arg)
|
|
|
943 "Move down lines then position at filename.
|
|
|
944 Optional prefix ARG says how many lines to move; default is one line."
|
|
|
945 (interactive "_p")
|
|
|
946 (next-line arg)
|
|
|
947 (dired-move-to-filename))
|
|
|
948
|
|
|
949 (defun dired-previous-line (arg)
|
|
|
950 "Move up lines then position at filename.
|
|
|
951 Optional prefix ARG says how many lines to move; default is one line."
|
|
|
952 (interactive "_p")
|
|
|
953 (previous-line arg)
|
|
|
954 (dired-move-to-filename))
|
|
|
955
|
|
|
956 (defun dired-up-directory ()
|
|
|
957 "Run dired on parent directory of current directory.
|
|
|
958 Find the parent directory either in this buffer or another buffer.
|
|
|
959 Creates a buffer if necessary."
|
|
|
960 (interactive)
|
|
|
961 (let* ((dir (dired-current-directory))
|
|
|
962 (up (file-name-directory (directory-file-name dir))))
|
|
|
963 (or (dired-goto-file (directory-file-name dir))
|
|
|
964 (dired-goto-subdir up)
|
|
|
965 (progn
|
|
|
966 (dired up)
|
|
|
967 (dired-goto-file dir)))))
|
|
|
968
|
|
|
969 (defun dired-find-file ()
|
|
|
970 "In dired, visit the file or directory named on this line."
|
|
|
971 (interactive)
|
|
|
972 (let ((find-file-run-dired t))
|
|
|
973 (find-file (dired-get-filename))))
|
|
|
974
|
|
|
975 (defun dired-view-file ()
|
|
|
976 "In dired, examine a file in view mode, returning to dired when done.
|
|
|
977 When file is a directory, show it in this buffer if it is inserted;
|
|
|
978 otherwise, display it in another buffer."
|
|
|
979 (interactive)
|
|
|
980 (if (file-directory-p (dired-get-filename))
|
|
|
981 (or (dired-goto-subdir (dired-get-filename))
|
|
|
982 (dired (dired-get-filename)))
|
|
|
983 (view-file (dired-get-filename))))
|
|
|
984
|
|
|
985 (defun dired-find-file-other-window ()
|
|
|
986 "In dired, visit this file or directory in another window."
|
|
|
987 (interactive)
|
|
|
988 (let ((find-file-run-dired t)) ;; XEmacs
|
|
|
989 (find-file-other-window (dired-get-filename))))
|
|
|
990
|
|
|
991 (defun dired-get-filename (&optional localp no-error-if-not-filep)
|
|
|
992 "In dired, return name of file mentioned on this line.
|
|
|
993 Value returned normally includes the directory name.
|
|
|
994 Optional arg LOCALP with value `no-dir' means don't include directory
|
|
|
995 name in result. A value of t means use path name relative to
|
|
|
996 `default-directory', which still may contain slashes if in a subdirectory.
|
|
|
997 Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
|
|
|
998 this line, otherwise an error occurs."
|
|
|
999 (let (case-fold-search file p1 p2)
|
|
|
1000 (save-excursion
|
|
|
1001 (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
|
|
|
1002 (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
|
|
|
1003 ;; nil if no file on this line, but no-error-if-not-filep is t:
|
|
|
1004 (if (setq file (and p1 p2 (buffer-substring p1 p2)))
|
|
|
1005 ;; Check if ls quoted the names, and unquote them.
|
|
|
1006 ;; Using read to unquote is much faster than substituting
|
|
|
1007 ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
|
|
|
1008 (cond ((string-match "b" dired-actual-switches) ; System V ls
|
|
|
1009 ;; This case is about 20% slower than without -b.
|
|
|
1010 (setq file
|
|
|
1011 (read
|
|
|
1012 (concat "\""
|
|
|
1013 ;; some ls -b don't escape quotes, argh!
|
|
|
1014 ;; This is not needed for GNU ls, though.
|
|
|
1015 (or (dired-string-replace-match
|
|
|
1016 "\\([^\\]\\)\"" file "\\1\\\\\"")
|
|
|
1017 file)
|
|
|
1018 "\""))))
|
|
|
1019 ;; If you do this, update dired-insert-subdir-validate too
|
|
|
1020 ;; ((string-match "Q" dired-actual-switches) ; GNU ls
|
|
|
1021 ;; (setq file (read file)))
|
|
|
1022 ))
|
|
|
1023 (if (eq localp 'no-dir)
|
|
|
1024 file
|
|
|
1025 (and file (concat (dired-current-directory localp) file)))))
|
|
|
1026
|
|
|
1027 (defun dired-move-to-filename (&optional raise-error eol)
|
|
|
1028 "In dired, move to first char of filename on this line.
|
|
|
1029 Returns position (point) or nil if no filename on this line."
|
|
|
1030 ;; This is the UNIX version.
|
|
|
1031 (or eol (setq eol (progn (end-of-line) (point))))
|
|
|
1032 (beginning-of-line)
|
|
|
1033 (if (string-match "l" dired-actual-switches)
|
|
|
1034 (if (re-search-forward
|
|
|
1035 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
|
|
|
1036 eol t)
|
|
|
1037 (progn
|
|
|
1038 (skip-chars-forward " ") ; there is one SPC after day of month
|
|
|
1039 (skip-chars-forward "^ " eol) ; move after time of day (or year)
|
|
|
1040 (skip-chars-forward " " eol) ; there is space before the file name
|
|
|
1041 ;; Actually, if the year instead of clock time is displayed,
|
|
|
1042 ;; there are (only for some ls programs?) two spaces instead
|
|
|
1043 ;; of one before the name.
|
|
|
1044 ;; If we could depend on ls inserting exactly one SPC we
|
|
|
1045 ;; would not bomb on names _starting_ with SPC.
|
|
|
1046 (point))
|
|
|
1047 (if raise-error
|
|
|
1048 (error "No file on this line")
|
|
|
1049 nil))
|
|
|
1050 ;; else ls switches don't contain -l.
|
|
|
1051 ;; Note that even if we make dired-move-to-filename and
|
|
|
1052 ;; dired-move-to-end-of-filename (and thus dired-get-filename)
|
|
|
1053 ;; work, all commands that gleaned information from the permission
|
|
|
1054 ;; bits (like dired-mark-directories) will cease to work properly.
|
|
|
1055 (if (eolp)
|
|
|
1056 (if raise-error
|
|
|
1057 (error "No file on this line")
|
|
|
1058 nil)
|
|
|
1059 ;; skip marker, if any
|
|
|
1060 (forward-char))
|
|
|
1061 (skip-chars-forward " ")
|
|
|
1062 (point)))
|
|
|
1063
|
|
|
1064 (defun dired-move-to-end-of-filename (&optional no-error)
|
|
|
1065 ;; Assumes point is at beginning of filename,
|
|
|
1066 ;; thus the rwx bit re-search-backward below will succeed in *this*
|
|
|
1067 ;; line if at all. So, it should be called only after
|
|
|
1068 ;; (dired-move-to-filename t).
|
|
|
1069 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
|
|
|
1070 ;; This is the UNIX version.
|
|
|
1071 (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
|
|
|
1072 ;; case-fold-search is nil now, so we can test for capital F:
|
|
|
1073 (setq used-F (string-match "F" dired-actual-switches)
|
|
|
1074 opoint (point)
|
|
|
1075 eol (save-excursion (end-of-line) (point))
|
|
|
1076 hidden (and selective-display
|
|
|
1077 (save-excursion (search-forward "\r" eol t))))
|
|
|
1078 (if hidden
|
|
|
1079 nil
|
|
|
1080 (save-excursion;; Find out what kind of file this is:
|
|
|
1081 ;; Restrict perm bits to be non-blank,
|
|
|
1082 ;; otherwise this matches one char to early (looking backward):
|
|
|
1083 ;; "l---------" (some systems make symlinks that way)
|
|
|
1084 ;; "----------" (plain file with zero perms)
|
|
|
1085 (if (re-search-backward
|
|
|
1086 "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
|
|
|
1087 nil t)
|
|
|
1088 (setq file-type (char-after (match-beginning 1))
|
|
|
1089 symlink (eq file-type ?l)
|
|
|
1090 ;; Only with -F we need to know whether it's an executable
|
|
|
1091 executable (and
|
|
|
1092 used-F
|
|
|
1093 (string-match
|
|
|
1094 "[xst]";; execute bit set anywhere?
|
|
|
1095 (concat
|
|
|
1096 (buffer-substring (match-beginning 2)
|
|
|
1097 (match-end 2))
|
|
|
1098 (buffer-substring (match-beginning 3)
|
|
|
1099 (match-end 3))
|
|
|
1100 (buffer-substring (match-beginning 4)
|
|
|
1101 (match-end 4))))))
|
|
|
1102 (or no-error
|
|
|
1103 (not (string-match "l" dired-actual-switches))
|
|
|
1104 (error "No file on this line"))))
|
|
|
1105 ;; Move point to end of name:
|
|
|
1106 (if symlink
|
|
|
1107 (if (search-forward " ->" eol t)
|
|
|
1108 (progn
|
|
|
1109 (forward-char -3)
|
|
|
1110 (and used-F
|
|
|
1111 dired-ls-F-marks-symlinks
|
|
|
1112 (eq (preceding-char) ?@);; did ls really mark the link?
|
|
|
1113 (forward-char -1))))
|
|
|
1114 (goto-char eol);; else not a symbolic link
|
|
|
1115 ;; ls -lF marks dirs, sockets and executables with exactly one
|
|
|
1116 ;; trailing character. (Executable bits on symlinks ain't mean
|
|
|
1117 ;; a thing, even to ls, but we know it's not a symlink.)
|
|
|
1118 (and used-F
|
|
|
1119 ;; -F may not actually be honored, e.g. by an FTP ls in ange-ftp
|
|
|
1120 (let ((char (preceding-char)))
|
|
|
1121 (or (and (eq file-type ?d) (eq char ?/))
|
|
|
1122 (and executable (eq char ?*))
|
|
|
1123 (and (eq file-type ?s) (eq char ?=))))
|
|
|
1124 (forward-char -1))))
|
|
|
1125 (or no-error
|
|
|
1126 (not (eq opoint (point)))
|
|
|
1127 (error (if hidden
|
|
|
1128 (substitute-command-keys
|
|
|
1129 "File line is hidden, type \\[dired-hide-subdir] to unhide")
|
|
|
1130 "No file on this line")))
|
|
|
1131 (if (eq opoint (point))
|
|
|
1132 nil
|
|
|
1133 (point))))
|
|
|
1134
|
|
|
1135
|
|
|
1136 ;; Perhaps something could be done to handle VMS' own backups.
|
|
|
1137
|
|
|
1138 (defun dired-clean-directory (keep)
|
|
|
1139 "Flag numerical backups for deletion.
|
|
|
1140 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
|
|
|
1141 Positive prefix arg KEEP overrides `dired-kept-versions';
|
|
|
1142 Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
|
|
|
1143
|
|
|
1144 To clear the flags on these files, you can use \\[dired-flag-backup-files]
|
|
|
1145 with a prefix argument."
|
|
|
1146 (interactive "P")
|
|
|
1147 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
|
|
|
1148 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
|
|
|
1149 (late-retention (if (<= keep 0) dired-kept-versions keep))
|
|
|
1150 (file-version-assoc-list ()))
|
|
|
1151 (message "Cleaning numerical backups (keeping %d late, %d old)..."
|
|
|
1152 late-retention early-retention)
|
|
|
1153 ;; Look at each file.
|
|
|
1154 ;; If the file has numeric backup versions,
|
|
|
1155 ;; put on file-version-assoc-list an element of the form
|
|
|
1156 ;; (FILENAME . VERSION-NUMBER-LIST)
|
|
|
1157 (dired-map-dired-file-lines (function dired-collect-file-versions))
|
|
|
1158 ;; Sort each VERSION-NUMBER-LIST,
|
|
|
1159 ;; and remove the versions not to be deleted.
|
|
|
1160 (let ((fval file-version-assoc-list))
|
|
|
1161 (while fval
|
|
|
1162 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
|
|
|
1163 (v-count (length sorted-v-list)))
|
|
|
1164 (if (> v-count (+ early-retention late-retention))
|
|
|
1165 (rplacd (nthcdr early-retention sorted-v-list)
|
|
|
1166 (nthcdr (- v-count late-retention)
|
|
|
1167 sorted-v-list)))
|
|
|
1168 (rplacd (car fval)
|
|
|
1169 (cdr sorted-v-list)))
|
|
|
1170 (setq fval (cdr fval))))
|
|
|
1171 ;; Look at each file. If it is a numeric backup file,
|
|
|
1172 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
|
|
|
1173 (dired-map-dired-file-lines (function dired-trample-file-versions))
|
|
|
1174 (message "Cleaning numerical backups...done")))
|
|
|
1175
|
|
|
1176 ;;; Subroutines of dired-clean-directory.
|
|
|
1177
|
|
|
1178 (defun dired-map-dired-file-lines (fun)
|
|
|
1179 ;; Perform FUN with point at the end of each non-directory line.
|
|
|
1180 ;; FUN takes one argument, the filename (complete pathname).
|
|
|
1181 (dired-check-ls-l)
|
|
|
1182 (save-excursion
|
|
|
1183 (let (file buffer-read-only)
|
|
|
1184 (goto-char (point-min))
|
|
|
1185 (while (not (eobp))
|
|
|
1186 (save-excursion
|
|
|
1187 (and (not (looking-at dired-re-dir))
|
|
|
1188 (not (eolp))
|
|
|
1189 (setq file (dired-get-filename nil t)) ; nil on non-file
|
|
|
1190 (progn (end-of-line)
|
|
|
1191 (funcall fun file))))
|
|
|
1192 (forward-line 1)))))
|
|
|
1193
|
|
|
1194 (defun dired-collect-file-versions (fn)
|
|
|
1195 ;; "If it looks like file FN has versions, return a list of the versions.
|
|
|
1196 ;;That is a list of strings which are file names.
|
|
|
1197 ;;The caller may want to flag some of these files for deletion."
|
|
|
1198 (let* ((base-versions
|
|
|
1199 (concat (file-name-nondirectory fn) ".~"))
|
|
|
1200 (bv-length (length base-versions))
|
|
|
1201 (possibilities (file-name-all-completions
|
|
|
1202 base-versions
|
|
|
1203 (file-name-directory fn)))
|
|
|
1204 (versions (mapcar 'backup-extract-version possibilities)))
|
|
|
1205 (if versions
|
|
|
1206 (setq file-version-assoc-list (cons (cons fn versions)
|
|
|
1207 file-version-assoc-list)))))
|
|
|
1208
|
|
|
1209 (defun dired-trample-file-versions (fn)
|
|
|
1210 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
|
|
|
1211 base-version-list)
|
|
|
1212 (and start-vn
|
|
|
1213 (setq base-version-list ; there was a base version to which
|
|
|
1214 (assoc (substring fn 0 start-vn) ; this looks like a
|
|
|
1215 file-version-assoc-list)) ; subversion
|
|
|
1216 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
|
|
|
1217 base-version-list)) ; this one doesn't make the cut
|
|
|
1218 (progn (beginning-of-line)
|
|
|
1219 (delete-char 1)
|
|
|
1220 (insert dired-del-marker)))))
|
|
|
1221
|
|
|
1222
|
|
|
1223 ;; Keeping Dired buffers in sync with the filesystem and with each other
|
|
|
1224
|
|
|
1225 (defvar dired-buffers nil
|
|
|
1226 ;; Enlarged by dired-advertise
|
|
|
1227 ;; Queried by function dired-buffers-for-dir. When this detects a
|
|
|
1228 ;; killed buffer, it is removed from this list.
|
|
|
1229 "Alist of directories and their associated dired buffers.")
|
|
|
1230
|
|
|
1231 (defun dired-buffers-for-dir (dir)
|
|
|
1232 ;; Return a list of buffers that dired DIR (top level or in-situ subdir).
|
|
|
1233 ;; The list is in reverse order of buffer creation, most recent last.
|
|
|
1234 ;; As a side effect, killed dired buffers for DIR are removed from
|
|
|
1235 ;; dired-buffers.
|
|
|
1236 (setq dir (file-name-as-directory dir))
|
|
|
1237 (let ((alist dired-buffers) result elt)
|
|
|
1238 (while alist
|
|
|
1239 (setq elt (car alist))
|
|
|
1240 (if (dired-in-this-tree dir (car elt))
|
|
|
1241 (let ((buf (cdr elt)))
|
|
|
1242 (if (buffer-name buf)
|
|
|
1243 (if (assoc dir (save-excursion
|
|
|
1244 (set-buffer buf)
|
|
|
1245 dired-subdir-alist))
|
|
|
1246 (setq result (cons buf result)))
|
|
|
1247 ;; else buffer is killed - clean up:
|
|
|
1248 (setq dired-buffers (delq elt dired-buffers)))))
|
|
|
1249 (setq alist (cdr alist)))
|
|
|
1250 result))
|
|
|
1251
|
|
|
1252 (defun dired-advertise ()
|
|
|
1253 ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
|
|
|
1254 ;; With wildcards we actually advertise too much.
|
|
|
1255 (if (memq (current-buffer) (dired-buffers-for-dir default-directory))
|
|
|
1256 t ; we have already advertised ourselves
|
|
|
1257 (setq dired-buffers
|
|
|
1258 (cons (cons default-directory (current-buffer))
|
|
|
1259 dired-buffers))))
|
|
|
1260
|
|
|
1261 (defun dired-unadvertise (dir)
|
|
|
1262 ;; Remove DIR from the buffer alist in variable dired-buffers.
|
|
|
1263 ;; This has the effect of removing any buffer whose main directory is DIR.
|
|
|
1264 ;; It does not affect buffers in which DIR is a subdir.
|
|
|
1265 ;; Removing is also done as a side-effect in dired-buffer-for-dir.
|
|
|
1266 (setq dired-buffers
|
|
|
1267 (delq (assoc dir dired-buffers) dired-buffers)))
|
|
|
1268
|
|
|
1269 (defun dired-fun-in-all-buffers (directory fun &rest args)
|
|
|
1270 ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
|
|
|
1271 ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
|
|
|
1272 (let ((buf-list (dired-buffers-for-dir directory))
|
|
|
1273 (obuf (current-buffer))
|
|
|
1274 buf success-list)
|
|
|
1275 (while buf-list
|
|
|
1276 (setq buf (car buf-list)
|
|
|
1277 buf-list (cdr buf-list))
|
|
|
1278 (unwind-protect
|
|
|
1279 (progn
|
|
|
1280 (set-buffer buf)
|
|
|
1281 (if (apply fun args)
|
|
|
1282 (setq success-list (cons (buffer-name buf) success-list))))
|
|
|
1283 (set-buffer obuf)))
|
|
|
1284 success-list))
|
|
|
1285
|
|
|
1286 (defun dired-add-file (filename &optional marker-char)
|
|
|
1287 (dired-fun-in-all-buffers
|
|
|
1288 (file-name-directory filename)
|
|
|
1289 (function dired-add-entry) filename marker-char))
|
|
|
1290
|
|
|
1291 (defun dired-add-entry (filename &optional marker-char)
|
|
|
1292 ;; Add a new entry for FILENAME, optionally marking it
|
|
|
1293 ;; with MARKER-CHAR (a character, else dired-marker-char is used).
|
|
|
1294 ;; Note that this adds the entry `out of order' if files sorted by
|
|
|
1295 ;; time, etc.
|
|
|
1296 ;; At least this version inserts in the right subdirectory (if present).
|
|
|
1297 ;; And it skips "." or ".." (see `dired-trivial-filenames').
|
|
|
1298 ;; Hidden subdirs are exposed if a file is added there.
|
|
|
1299 (setq filename (directory-file-name filename))
|
|
|
1300 ;; Entry is always for files, even if they happen to also be directories
|
|
|
1301 (let ((opoint (point))
|
|
|
1302 (cur-dir (dired-current-directory))
|
|
|
1303 (directory (file-name-directory filename))
|
|
|
1304 reason)
|
|
|
1305 (setq filename (file-name-nondirectory filename)
|
|
|
1306 reason
|
|
|
1307 (catch 'not-found
|
|
|
1308 (if (string= directory cur-dir)
|
|
|
1309 (progn
|
|
|
1310 (if (dired-subdir-hidden-p cur-dir)
|
|
|
1311 (dired-unhide-subdir))
|
|
|
1312 ;; We are already where we should be, except when
|
|
|
1313 ;; point is before the subdir line or its total line.
|
|
|
1314 (let ((p (dired-after-subdir-garbage cur-dir)))
|
|
|
1315 (if (< (point) p)
|
|
|
1316 (goto-char p))))
|
|
|
1317 ;; else try to find correct place to insert
|
|
|
1318 (if (dired-goto-subdir directory)
|
|
|
1319 (progn;; unhide if necessary
|
|
|
1320 (if (looking-at "\r");; point is at end of subdir line
|
|
|
1321 (dired-unhide-subdir))
|
|
|
1322 ;; found - skip subdir and `total' line
|
|
|
1323 ;; and uninteresting files like . and ..
|
|
|
1324 ;; This better not moves into the next subdir!
|
|
|
1325 (dired-goto-next-nontrivial-file))
|
|
|
1326 ;; not found
|
|
|
1327 (throw 'not-found "Subdir not found")))
|
|
|
1328 ;; found and point is at The Right Place:
|
|
|
1329 (let (buffer-read-only)
|
|
|
1330 (beginning-of-line)
|
|
|
1331 (dired-add-entry-do-indentation marker-char)
|
|
|
1332 (dired-ls (dired-make-absolute filename directory);; don't expand `.' !
|
|
|
1333 (concat dired-actual-switches "d"))
|
|
|
1334 (forward-line -1)
|
|
|
1335 ;; We want to have the non-directory part, only:
|
|
|
1336 (let* ((beg (dired-move-to-filename t)) ; error for strange output
|
|
|
1337 (end (dired-move-to-end-of-filename)))
|
|
|
1338 (setq filename (buffer-substring beg end))
|
|
|
1339 (delete-region beg end)
|
|
|
1340 (insert (file-name-nondirectory filename)))
|
|
|
1341 (if dired-after-readin-hook;; the subdir-alist is not affected...
|
|
|
1342 (save-excursion;; ...so we can run it right now:
|
|
|
1343 (save-restriction
|
|
|
1344 (beginning-of-line)
|
|
|
1345 (narrow-to-region (point) (save-excursion
|
|
|
1346 (forward-line 1) (point)))
|
|
|
1347 (run-hooks 'dired-after-readin-hook))))
|
|
|
1348 (dired-move-to-filename))
|
|
|
1349 ;; return nil if all went well
|
|
|
1350 nil))
|
|
|
1351 (if reason ; don't move away on failure
|
|
|
1352 (goto-char opoint))
|
|
|
1353 (not reason))) ; return t on succes, nil else
|
|
|
1354
|
|
|
1355 ;; This is a separate function for the sake of nested dired format.
|
|
|
1356 (defun dired-add-entry-do-indentation (marker-char)
|
|
|
1357 ;; two spaces or a marker plus a space:
|
|
|
1358 (insert (if marker-char
|
|
|
1359 (if (integerp marker-char) marker-char dired-marker-char)
|
|
|
1360 ?\040)
|
|
|
1361 ?\040))
|
|
|
1362
|
|
|
1363 (defun dired-after-subdir-garbage (dir)
|
|
|
1364 ;; Return pos of first file line of DIR, skipping header and total
|
|
|
1365 ;; or wildcard lines.
|
|
|
1366 ;; Important: never moves into the next subdir.
|
|
|
1367 ;; DIR is assumed to be unhidden.
|
|
|
1368 ;; Will probably be redefined for VMS etc.
|
|
|
1369 (save-excursion
|
|
|
1370 (or (dired-goto-subdir dir) (error "This cannot happen"))
|
|
|
1371 (forward-line 1)
|
|
|
1372 (while (and (not (eolp)) ; don't cross subdir boundary
|
|
|
1373 (not (dired-move-to-filename)))
|
|
|
1374 (forward-line 1))
|
|
|
1375 (point)))
|
|
|
1376
|
|
|
1377 (defun dired-remove-file (file)
|
|
|
1378 (dired-fun-in-all-buffers
|
|
|
1379 (file-name-directory file) (function dired-remove-entry) file))
|
|
|
1380
|
|
|
1381 (defun dired-remove-entry (file)
|
|
|
1382 (save-excursion
|
|
|
1383 (and (dired-goto-file file)
|
|
|
1384 (let (buffer-read-only)
|
|
|
1385 (delete-region (progn (beginning-of-line) (point))
|
|
|
1386 (save-excursion (forward-line 1) (point)))))))
|
|
|
1387
|
|
|
1388 (defun dired-relist-file (file)
|
|
|
1389 (dired-fun-in-all-buffers (file-name-directory file)
|
|
|
1390 (function dired-relist-entry) file))
|
|
|
1391
|
|
|
1392 (defun dired-relist-entry (file)
|
|
|
1393 ;; Relist the line for FILE, or just add it if it did not exist.
|
|
|
1394 ;; FILE must be an absolute pathname.
|
|
|
1395 (let (buffer-read-only marker)
|
|
|
1396 ;; If cursor is already on FILE's line delete-region will cause
|
|
|
1397 ;; save-excursion to fail because of floating makers,
|
|
|
1398 ;; moving point to beginning of line. Sigh.
|
|
|
1399 (save-excursion
|
|
|
1400 (and (dired-goto-file file)
|
|
|
1401 (delete-region (progn (beginning-of-line)
|
|
|
1402 (setq marker (following-char))
|
|
|
1403 (point))
|
|
|
1404 (save-excursion (forward-line 1) (point))))
|
|
|
1405 (setq file (directory-file-name file))
|
|
|
1406 (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
|
|
|
1407
|
|
|
1408 (defun dired-update-file-line (file)
|
|
|
1409 ;; Delete the current line, and insert an entry for FILE.
|
|
|
1410 ;; If FILE is nil, then just delete the current line.
|
|
|
1411 ;; Keeps any marks that may be present in column one (doing this
|
|
|
1412 ;; here is faster than with dired-add-entry's optional arg).
|
|
|
1413 ;; Does not update other dired buffers. Use dired-relist-entry for that.
|
|
|
1414 (beginning-of-line)
|
|
|
1415 (let ((char (following-char)) (opoint (point)))
|
|
|
1416 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
1417 (if file
|
|
|
1418 (progn
|
|
|
1419 (dired-add-entry file)
|
|
|
1420 ;; Replace space by old marker without moving point.
|
|
|
1421 ;; Faster than goto+insdel inside a save-excursion?
|
|
|
1422 (subst-char-in-region opoint (1+ opoint) ?\040 char))))
|
|
|
1423 (dired-move-to-filename))
|
|
|
1424
|
|
|
1425
|
|
|
1426 ;; Running subprocesses, checking and logging of their errors.
|
|
|
1427
|
|
|
1428 (defvar dired-log-buf "*Dired log*")
|
|
|
1429
|
|
|
1430 (defun dired-why ()
|
|
|
1431 "Pop up a buffer with error log output from Dired.
|
|
|
1432 A group of errors from a single command ends with a formfeed.
|
|
|
1433 Thus, use \\[backward-page] to find the beginning of a group of errors."
|
|
|
1434 (interactive)
|
|
|
1435 (let ((obuf (current-buffer)))
|
|
|
1436 (pop-to-buffer dired-log-buf)
|
|
|
1437 (goto-char (point-max))
|
|
|
1438 (recenter -1)
|
|
|
1439 (switch-to-buffer-other-window obuf)))
|
|
|
1440
|
|
|
1441 (defun dired-log (log &rest args)
|
|
|
1442 ;; Log a message or the contents of a buffer.
|
|
|
1443 ;; If LOG is a string and there are more args, it is formatted with
|
|
|
1444 ;; those ARGS. Usually the LOG string ends with a \n.
|
|
|
1445 ;; End each bunch of errors with (dired-log t): this inserts
|
|
|
1446 ;; current time and buffer, and a \f (formfeed).
|
|
|
1447 (let ((obuf (current-buffer)))
|
|
|
1448 (unwind-protect ; want to move point
|
|
|
1449 (progn
|
|
|
1450 (set-buffer (get-buffer-create dired-log-buf))
|
|
|
1451 (goto-char (point-max))
|
|
|
1452 (let (buffer-read-only)
|
|
|
1453 (cond ((stringp log)
|
|
|
1454 (insert (if args
|
|
|
1455 (apply (function format) log args)
|
|
|
1456 log)))
|
|
|
1457 ((bufferp log)
|
|
|
1458 (insert-buffer log))
|
|
|
1459 ((eq t log)
|
|
|
1460 (insert "\n\t" (current-time-string)
|
|
|
1461 "\tBuffer `" (buffer-name obuf) "'\n\f\n")))))
|
|
|
1462 (set-buffer obuf))))
|
|
|
1463
|
|
|
1464 (defun dired-log-summary (log &rest args)
|
|
|
1465 ;; Log a summary describing a bunch of errors.
|
|
|
1466 (apply (function dired-log) (concat "\n" log) args)
|
|
|
1467 (dired-log t))
|
|
|
1468
|
|
|
1469 ;; In Emacs 19 this will return program's exit status.
|
|
|
1470 ;; This is a separate function so that ange-ftp can redefine it.
|
|
|
1471 (defun dired-call-process (program discard &rest arguments)
|
|
|
1472 ; "Run PROGRAM with output to current buffer unless DISCARD is t.
|
|
|
1473 ;Remaining arguments are strings passed as command arguments to PROGRAM."
|
|
|
1474 (apply 'call-process program nil (not discard) nil arguments))
|
|
|
1475
|
|
|
1476 (defun dired-check-process-checker (exit-status)
|
|
|
1477 ;; In Emacs 19, EXIT-STATUS comes from (dired-)call-process
|
|
|
1478 ;; Then this function should return (/= 0 exit-status)
|
|
|
1479 ;; In Emacs 18 the exit status is not accessible, so we
|
|
|
1480 ;; do the following which is not always correct as some compress
|
|
|
1481 ;; programs are verbose by default or otherwise braindamaged
|
|
|
1482 (if (and dired-emacs-19-p exit-status)
|
|
|
1483 (/= 0 exit-status);; #### install (does it work in Emacs 19?)
|
|
|
1484 (/= 0 (buffer-size))) ; run in program's output buffer
|
|
|
1485 ;; If have you one of those compress programs, you might
|
|
|
1486 ;; want to redefine this function to look closer at compress' output.
|
|
|
1487 ;; This is why it is a separate function.
|
|
|
1488 )
|
|
|
1489
|
|
|
1490 (defun dired-check-process (msg program &rest arguments)
|
|
|
1491 ; "Display MSG while running PROGRAM, and check for output.
|
|
|
1492 ;Remaining arguments are strings passed as command arguments to PROGRAM.
|
|
|
1493 ; On error as determined by dired-check-process-checker, insert output
|
|
|
1494 ; in a log buffer and return the offending ARGUMENTS or PROGRAM.
|
|
|
1495 ; Caller can cons up a list of failed args.
|
|
|
1496 ;Else returns nil for success."
|
|
|
1497 (let (err-buffer err (dir default-directory))
|
|
|
1498 (message "%s..." msg)
|
|
|
1499 (save-excursion
|
|
|
1500 ;; Get a clean buffer for error output:
|
|
|
1501 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
|
|
|
1502 (set-buffer err-buffer)
|
|
|
1503 (erase-buffer)
|
|
|
1504 (setq default-directory dir ; caller's default-directory
|
|
|
1505 err (dired-check-process-checker
|
|
|
1506 (apply (function dired-call-process) program nil arguments)))
|
|
|
1507 (if err
|
|
|
1508 (progn
|
|
|
1509 (dired-log (concat program " " (prin1-to-string arguments) "\n"))
|
|
|
1510 (dired-log err-buffer)
|
|
|
1511 (or arguments program t))
|
|
|
1512 (kill-buffer err-buffer)
|
|
|
1513 (message "%s...done" msg)
|
|
|
1514 nil))))
|
|
|
1515
|
|
|
1516 ;;; 7K
|
|
|
1517 ;;;###begin dired-cmd.el
|
|
|
1518 ;; Diffing and compressing
|
|
|
1519
|
|
|
1520 (defun dired-diff (file &optional switches)
|
|
|
1521 "Compare file at point with file FILE using `diff'.
|
|
|
1522 FILE defaults to the file at the mark.
|
|
|
1523 The prompted-for file is the first file given to `diff'.
|
|
|
1524 Prefix arg lets you edit the diff switches. See the command `diff'."
|
|
|
1525 (interactive
|
|
|
1526 (let ((default (if (mark)
|
|
|
1527 (save-excursion (goto-char (mark))
|
|
|
1528 (dired-get-filename t t)))))
|
|
|
1529 (list (read-file-name (format "Diff %s with: %s"
|
|
|
1530 (dired-get-filename t)
|
|
|
1531 (if default
|
|
|
1532 (concat "(default " default ") ")
|
|
|
1533 ""))
|
|
|
1534 (dired-current-directory) default t)
|
|
|
1535 (if (fboundp 'diff-read-switches)
|
|
|
1536 (diff-read-switches "Options for diff: ")))))
|
|
|
1537 (if switches ; Emacs 19's diff has but two
|
|
|
1538 (diff file (dired-get-filename t) switches) ; args (yet ;-)
|
|
|
1539 (diff file (dired-get-filename t))))
|
|
|
1540
|
|
|
1541 (defun dired-backup-diff (&optional switches)
|
|
|
1542 "Diff this file with its backup file or vice versa.
|
|
|
1543 Uses the latest backup, if there are several numerical backups.
|
|
|
1544 If this file is a backup, diff it with its original.
|
|
|
1545 The backup file is the first file given to `diff'.
|
|
|
1546 Prefix arg lets you edit the diff switches. See the command `diff'."
|
|
|
1547 (interactive (list (if (fboundp 'diff-read-switches)
|
|
|
1548 (diff-read-switches "Diff with switches: "))))
|
|
|
1549 (let (bak ori (file (dired-get-filename)))
|
|
|
1550 (if (backup-file-name-p file)
|
|
|
1551 (setq bak file
|
|
|
1552 ori (file-name-sans-versions file))
|
|
|
1553 (setq bak (or (latest-backup-file file)
|
|
|
1554 (error "No backup found for %s" file))
|
|
|
1555 ori file))
|
|
|
1556 (if switches
|
|
|
1557 (diff bak ori switches)
|
|
|
1558 (diff bak ori))))
|
|
|
1559
|
|
|
1560 ;;#### install (move this function into files.el)
|
|
|
1561 (defun latest-backup-file (fn) ; actually belongs into files.el
|
|
|
1562 "Return the latest existing backup of FILE, or nil."
|
|
|
1563 ;; First try simple backup, then the highest numbered of the
|
|
|
1564 ;; numbered backups.
|
|
|
1565 ;; Ignore the value of version-control because we look for existing
|
|
|
1566 ;; backups, which maybe were made earlier or by another user with
|
|
|
1567 ;; a different value of version-control.
|
|
|
1568 (setq fn (expand-file-name fn))
|
|
|
1569 (or
|
|
|
1570 (let ((bak (make-backup-file-name fn)))
|
|
|
1571 (if (file-exists-p bak) bak))
|
|
|
1572 (let* ((dir (file-name-directory fn))
|
|
|
1573 (base-versions (concat (file-name-nondirectory fn) ".~"))
|
|
|
1574 (bv-length (length base-versions)))
|
|
|
1575 (concat dir
|
|
|
1576 (car (sort
|
|
|
1577 (file-name-all-completions base-versions dir)
|
|
|
1578 ;; bv-length is a fluid var for backup-extract-version:
|
|
|
1579 (function
|
|
|
1580 (lambda (fn1 fn2)
|
|
|
1581 (> (backup-extract-version fn1)
|
|
|
1582 (backup-extract-version fn2))))))))))
|
|
|
1583
|
|
|
1584 ;; This is a separate function for the sake of ange-ftp.el
|
|
|
1585 (defun dired-compress-make-compressed-filename (from-file &optional reverse)
|
|
|
1586 ;; "Converts a filename FROM-FILE to the filename of the associated
|
|
|
1587 ;; compressed file. With an optional argument REVERSE, the reverse
|
|
|
1588 ;; conversion is done."
|
|
|
1589
|
|
|
1590 (if reverse
|
|
|
1591
|
|
|
1592 ;; uncompress...
|
|
|
1593 ;; return `nil' if no match found -- better than nothing
|
|
|
1594 (let (case-fold-search ; case-sensitive search
|
|
|
1595 (string
|
|
|
1596 (concat "\\.\\(g?z\\|" (regexp-quote dired-gzip-file-extension)
|
|
|
1597 "$\\|Z\\)$")))
|
|
|
1598
|
|
|
1599 (and (string-match string from-file)
|
|
|
1600 (substring from-file 0 (match-beginning 0))))
|
|
|
1601
|
|
|
1602 ;; compress...
|
|
|
1603 ;; note: it could be that `gz' is not the proper extension for gzip
|
|
|
1604 (concat from-file
|
|
|
1605 (if dired-use-gzip-instead-of-compress
|
|
|
1606 dired-gzip-file-extension ".Z"))))
|
|
|
1607
|
|
|
1608
|
|
|
1609 (defun dired-compress ()
|
|
|
1610 ;; Compress current file. Return nil for success, offending filename else.
|
|
|
1611 (dired-check-ls-l)
|
|
|
1612 (let* (buffer-read-only
|
|
|
1613 (from-file (dired-get-filename))
|
|
|
1614 (to-file (dired-compress-make-compressed-filename from-file)))
|
|
|
1615 (cond ((save-excursion (beginning-of-line)
|
|
|
1616 (looking-at dired-re-sym))
|
|
|
1617 (dired-log (concat "Attempt to compress a symbolic link:\n"
|
|
|
1618 from-file))
|
|
|
1619 (dired-make-relative from-file))
|
|
|
1620 (
|
|
|
1621
|
|
|
1622 (if dired-use-gzip-instead-of-compress
|
|
|
1623 ;; gzip (GNU zip)
|
|
|
1624 ;; use `-q' (quiet) switch for gzip in case GZIP environment
|
|
|
1625 ;; variable contains `--verbose' - lrd - Feb 18, 1993
|
|
|
1626 (dired-check-process (concat "Gzip'ing " from-file)
|
|
|
1627 "gzip" "--quiet" "--force" "--suffix"
|
|
|
1628 dired-gzip-file-extension from-file)
|
|
|
1629
|
|
|
1630 (dired-check-process (concat "Compressing " from-file)
|
|
|
1631 "compress" "-f" from-file))
|
|
|
1632 ;; errors from the process are already logged by dired-check-process
|
|
|
1633 (dired-make-relative from-file))
|
|
|
1634 (t
|
|
|
1635 (dired-update-file-line to-file)
|
|
|
1636 nil))))
|
|
|
1637
|
|
|
1638 (defun dired-uncompress ()
|
|
|
1639 ;; Uncompress current file. Return nil for success, offending filename else.
|
|
|
1640 (let* (buffer-read-only
|
|
|
1641 (from-file (dired-get-filename))
|
|
|
1642 (to-file (dired-compress-make-compressed-filename from-file t)))
|
|
|
1643 (if
|
|
|
1644 (if dired-use-gzip-instead-of-compress
|
|
|
1645 ;; gzip (GNU zip)
|
|
|
1646 ;; use `-q' (quiet) switch for gzip in case GZIP environment
|
|
|
1647 ;; variable contains `--verbose' - lrd - Feb 18, 1993
|
|
|
1648 (dired-check-process (concat "Gunzip'ing " from-file)
|
|
|
1649 "gzip" "--decompress" "--quiet" "--suffix"
|
|
|
1650 dired-gzip-file-extension from-file)
|
|
|
1651
|
|
|
1652 (dired-check-process (concat "Uncompressing " from-file)
|
|
|
1653 "uncompress" from-file))
|
|
|
1654
|
|
|
1655 (dired-make-relative from-file)
|
|
|
1656 (dired-update-file-line to-file)
|
|
|
1657 nil)))
|
|
|
1658
|
|
|
1659 (defun dired-mark-map-check (fun arg op-symbol &optional show-progress)
|
|
|
1660 ; "Map FUN over marked files (with second ARG like in dired-mark-map)
|
|
|
1661 ; and display failures.
|
|
|
1662
|
|
|
1663 ; FUN takes zero args. It returns non-nil (the offending object, e.g.
|
|
|
1664 ; the short form of the filename) for a failure and probably logs a
|
|
|
1665 ; detailed error explanation using function `dired-log'.
|
|
|
1666
|
|
|
1667 ; OP-SYMBOL is a symbol describing the operation performed (e.g.
|
|
|
1668 ; `compress'). It is used with `dired-mark-pop-up' to prompt the user
|
|
|
1669 ; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
|
|
|
1670 ; `Failed to compress 1 of 2 files - type W to see why ("foo")')
|
|
|
1671
|
|
|
1672 ; SHOW-PROGRESS if non-nil means redisplay dired after each file."
|
|
|
1673 (if (dired-mark-confirm op-symbol arg)
|
|
|
1674 (let* ((total-list;; all of FUN's return values
|
|
|
1675 (dired-mark-map (funcall fun) arg show-progress))
|
|
|
1676 (total (length total-list))
|
|
|
1677 (failures (delq nil total-list))
|
|
|
1678 (count (length failures)))
|
|
|
1679 (if (not failures)
|
|
|
1680 (message "%s: %d file%s."
|
|
|
1681 (capitalize (symbol-name op-symbol))
|
|
|
1682 total (dired-plural-s total))
|
|
|
1683 (message "Failed to %s %d of %d file%s - type W to see why %s"
|
|
|
1684 (symbol-name op-symbol) count total (dired-plural-s total)
|
|
|
1685 ;; this gives a short list of failed files in parens
|
|
|
1686 ;; which may be sufficient for the user even
|
|
|
1687 ;; without typing `W' for the process' diagnostics
|
|
|
1688 failures)
|
|
|
1689 ;; end this bunch of errors:
|
|
|
1690 (dired-log-summary
|
|
|
1691 "Failed to %s %d of %d file%s"
|
|
|
1692 (symbol-name op-symbol) count total (dired-plural-s total))))))
|
|
|
1693
|
|
|
1694 (defun dired-do-compress (&optional arg)
|
|
|
1695 "Compress marked (or next ARG) files.
|
|
|
1696 Type \\[dired-do-uncompress] to uncompress again."
|
|
|
1697 (interactive "P")
|
|
|
1698 (dired-mark-map-check (function dired-compress) arg 'compress t))
|
|
|
1699
|
|
|
1700 (defun dired-do-uncompress (&optional arg)
|
|
|
1701 "Uncompress marked (or next ARG) files."
|
|
|
1702 (interactive "P")
|
|
|
1703 (dired-mark-map-check (function dired-uncompress) arg 'uncompress t))
|
|
|
1704
|
|
|
1705 ;; Commands for Emacs Lisp files - load and byte compile
|
|
|
1706
|
|
|
1707 (defun dired-byte-compile ()
|
|
|
1708 ;; Return nil for success, offending file name else.
|
|
|
1709 (let* ((filename (dired-get-filename))
|
|
|
1710 (elc-file
|
|
|
1711 (if (eq system-type 'vax-vms)
|
|
|
1712 (concat (substring filename 0 (string-match ";" filename)) "c")
|
|
|
1713 (concat filename "c")))
|
|
|
1714 buffer-read-only failure)
|
|
|
1715 (condition-case err
|
|
|
1716 (save-excursion (byte-compile-file filename))
|
|
|
1717 (error
|
|
|
1718 (setq failure err)))
|
|
|
1719 (if failure
|
|
|
1720 (progn
|
|
|
1721 (dired-log "Byte compile error for %s:\n%s\n" filename failure)
|
|
|
1722 (dired-make-relative filename))
|
|
|
1723 (dired-remove-file elc-file)
|
|
|
1724 (forward-line) ; insert .elc after its .el file
|
|
|
1725 (dired-add-file elc-file)
|
|
|
1726 nil)))
|
|
|
1727
|
|
|
1728 (defun dired-do-byte-compile (&optional arg)
|
|
|
1729 "Byte compile marked (or next ARG) Emacs lisp files."
|
|
|
1730 (interactive "P")
|
|
|
1731 (dired-mark-map-check (function dired-byte-compile) arg 'byte-compile t))
|
|
|
1732
|
|
|
1733 (defun dired-load ()
|
|
|
1734 ;; Return nil for success, offending file name else.
|
|
|
1735 (let ((file (dired-get-filename)) failure)
|
|
|
1736 (condition-case err
|
|
|
1737 (load file nil nil t)
|
|
|
1738 (error (setq failure err)))
|
|
|
1739 (if (not failure)
|
|
|
1740 nil
|
|
|
1741 (dired-log "Load error for %s:\n%s\n" file failure)
|
|
|
1742 (dired-make-relative file))))
|
|
|
1743
|
|
|
1744 (defun dired-do-load (&optional arg)
|
|
|
1745 "Load the marked (or next ARG) Emacs lisp files."
|
|
|
1746 (interactive "P")
|
|
|
1747 (dired-mark-map-check (function dired-load) arg 'load t))
|
|
|
1748
|
|
|
1749 (defun dired-do-chxxx (attribute-name program op-symbol arg)
|
|
|
1750 ;; Change file attributes (mode, group, owner) of marked files and
|
|
|
1751 ;; refresh their file lines.
|
|
|
1752 ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
|
|
|
1753 ;; PROGRAM is the program used to change the attribute.
|
|
|
1754 ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
|
|
|
1755 ;; ARG describes which files to use, like in dired-mark-get-files.
|
|
|
1756 (let* ((files (dired-mark-get-files t arg))
|
|
|
1757 (new-attribute
|
|
|
1758 (dired-mark-read-string
|
|
|
1759 (concat "Change " attribute-name " of %s to: ")
|
|
|
1760 nil op-symbol arg files))
|
|
|
1761 (operation (concat program " " new-attribute))
|
|
|
1762 (failure (apply (function dired-check-process)
|
|
|
1763 operation program new-attribute
|
|
|
1764 files)))
|
|
|
1765 (dired-do-redisplay arg);; moves point if ARG is an integer
|
|
|
1766 (if failure
|
|
|
1767 (dired-log-summary
|
|
|
1768 (message "%s: error - type W to see why." operation)))))
|
|
|
1769
|
|
|
1770 (defun dired-do-chmod (&optional arg)
|
|
|
1771 "Change the mode of the marked (or next ARG) files.
|
|
|
1772 This calls chmod, thus symbolic modes like `g+w' are allowed."
|
|
|
1773 (interactive "P")
|
|
|
1774 (dired-do-chxxx "Mode" "chmod" 'chmod arg))
|
|
|
1775
|
|
|
1776 (defun dired-do-chgrp (&optional arg)
|
|
|
1777 "Change the group of the marked (or next ARG) files."
|
|
|
1778 (interactive "P")
|
|
|
1779 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
|
|
|
1780
|
|
|
1781 (defun dired-do-chown (&optional arg)
|
|
|
1782 "Change the owner of the marked (or next ARG) files."
|
|
|
1783 (interactive "P")
|
|
|
1784 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
|
|
|
1785
|
|
|
1786 ;;;###end dired-cmd.el
|
|
|
1787
|
|
|
1788
|
|
|
1789 ;; Deleting files
|
|
|
1790
|
|
|
1791 ;; #### called dired-do-flagged-delete in FSF
|
|
|
1792 (defun dired-do-deletions (&optional nomessage)
|
|
|
1793 "In dired, delete the files flagged for deletion.
|
|
|
1794 If NOMESSAGE is non-nil, we don't display any message
|
|
|
1795 if there are no flagged files."
|
|
|
1796 (interactive)
|
|
|
1797 (let* ((dired-marker-char dired-del-marker)
|
|
|
1798 (regexp (dired-marker-regexp))
|
|
|
1799 case-fold-search)
|
|
|
1800 (if (save-excursion (goto-char (point-min))
|
|
|
1801 (re-search-forward regexp nil t))
|
|
|
1802 (dired-internal-do-deletions
|
|
|
1803 ;; this can't move point since ARG is nil
|
|
|
1804 (dired-mark-map (cons (dired-get-filename) (point))
|
|
|
1805 nil)
|
|
|
1806 nil)
|
|
|
1807 (or nomessage
|
|
|
1808 (message "(No deletions requested)")))))
|
|
|
1809
|
|
|
1810 (defun dired-do-delete (&optional arg)
|
|
|
1811 "Delete all marked (or next ARG) files."
|
|
|
1812 ;; This is more consistent with the file marking feature than
|
|
|
1813 ;; dired-do-deletions.
|
|
|
1814 (interactive "P")
|
|
|
1815 (dired-internal-do-deletions
|
|
|
1816 ;; this may move point if ARG is an integer
|
|
|
1817 (dired-mark-map (cons (dired-get-filename) (point))
|
|
|
1818 arg)
|
|
|
1819 arg))
|
|
|
1820
|
|
|
1821 (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
|
|
|
1822
|
|
|
1823 (defun dired-internal-do-deletions (l arg)
|
|
|
1824 ;; L is an alist of files to delete, with their buffer positions.
|
|
|
1825 ;; ARG is the prefix arg.
|
|
|
1826 ;; Filenames are absolute (VMS needs this for logical search paths).
|
|
|
1827 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
|
|
|
1828 ;; That way as changes are made in the buffer they do not shift the
|
|
|
1829 ;; lines still to be changed, so the (point) values in L stay valid.
|
|
|
1830 ;; Also, for subdirs in natural order, a subdir's files are deleted
|
|
|
1831 ;; before the subdir itself - the other way around would not work.
|
|
|
1832 (let ((files (mapcar (function car) l))
|
|
|
1833 (count (length l))
|
|
|
1834 (succ 0))
|
|
|
1835 ;; canonicalize file list for pop up
|
|
|
1836 (setq files (nreverse (mapcar (function dired-make-relative) files)))
|
|
|
1837 (if (dired-mark-pop-up
|
|
|
1838 " *Deletions*" 'delete files dired-deletion-confirmer
|
|
|
1839 (format "Delete %s " (dired-mark-prompt arg files)))
|
|
|
1840 (save-excursion
|
|
|
1841 (let (failures);; files better be in reverse order for this loop!
|
|
|
1842 (while l
|
|
|
1843 (goto-char (cdr (car l)))
|
|
|
1844 (let (buffer-read-only)
|
|
|
1845 (condition-case err
|
|
|
1846 (let ((fn (car (car l))))
|
|
|
1847 ;; This test is equivalent to
|
|
|
1848 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
|
|
|
1849 ;; but more efficient
|
|
|
1850 (if (eq t (car (file-attributes fn)))
|
|
|
1851 (remove-directory fn)
|
|
|
1852 (delete-file fn))
|
|
|
1853 ;; if we get here, removing worked
|
|
|
1854 (setq succ (1+ succ))
|
|
|
1855 (message "%s of %s deletions" succ count)
|
|
|
1856 (delete-region (progn (beginning-of-line) (point))
|
|
|
1857 (progn (forward-line 1) (point)))
|
|
|
1858 (dired-clean-up-after-deletion fn))
|
|
|
1859 (error;; catch errors from failed deletions
|
|
|
1860 (dired-log "%s\n" err)
|
|
|
1861 (setq failures (cons (car (car l)) failures)))))
|
|
|
1862 (setq l (cdr l)))
|
|
|
1863 (if (not failures)
|
|
|
1864 (message "%d deletion%s done" count (dired-plural-s count))
|
|
|
1865 (dired-log-summary
|
|
|
1866 (message "%d of %d deletion%s failed: %s"
|
|
|
1867 (length failures) count
|
|
|
1868 (dired-plural-s count)
|
|
|
1869 (prin1-to-string failures))))))
|
|
|
1870 (message "(No deletions performed)")))
|
|
|
1871 (dired-move-to-filename))
|
|
|
1872
|
|
|
1873 ;; This is a separate function for the sake of dired-x.el.
|
|
|
1874 (defun dired-clean-up-after-deletion (fn)
|
|
|
1875 ;; Clean up after a deleted file or directory FN.
|
|
|
1876 (save-excursion (and (dired-goto-subdir fn)
|
|
|
1877 (dired-kill-subdir))))
|
|
|
1878
|
|
|
1879
|
|
|
1880 (defun dired-replace-in-string (regexp newtext string)
|
|
|
1881 ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
|
|
|
1882 ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
|
|
|
1883 (let ((result "") (start 0) mb me)
|
|
|
1884 (while (string-match regexp string start)
|
|
|
1885 (setq mb (match-beginning 0)
|
|
|
1886 me (match-end 0)
|
|
|
1887 result (concat result (substring string start mb) newtext)
|
|
|
1888 start me))
|
|
|
1889 (concat result (substring string start))))
|
|
|
1890
|
|
|
1891 (defun dired-next-dirline (arg &optional opoint)
|
|
|
1892 "Goto ARG'th next directory file line."
|
|
|
1893 (interactive "_p")
|
|
|
1894 (dired-check-ls-l)
|
|
|
1895 (or opoint (setq opoint (point)))
|
|
|
1896 (if (if (> arg 0)
|
|
|
1897 (re-search-forward dired-re-dir nil t arg)
|
|
|
1898 (beginning-of-line)
|
|
|
1899 (re-search-backward dired-re-dir nil t (- arg)))
|
|
|
1900 (dired-move-to-filename) ; user may type `i' or `f'
|
|
|
1901 (goto-char opoint)
|
|
|
1902 (error "No more subdirectories")))
|
|
|
1903
|
|
|
1904 (defun dired-prev-dirline (arg)
|
|
|
1905 "Goto ARG'th previous directory file line."
|
|
|
1906 (interactive "_p")
|
|
|
1907 (dired-next-dirline (- arg)))
|
|
|
1908
|
|
|
1909 (defun dired-unflag-all-files (flag &optional arg)
|
|
|
1910 "Remove a specific or all flags from every file.
|
|
|
1911 With an arg, queries for each marked file.
|
|
|
1912 Type \\[help-command] at that time for help."
|
|
|
1913 (interactive "sRemove flag: (default: all flags) \nP")
|
|
|
1914 (let ((count 0)
|
|
|
1915 (re (if (zerop (length flag)) dired-re-mark
|
|
|
1916 (concat "^" (regexp-quote flag)))))
|
|
|
1917 (save-excursion
|
|
|
1918 (let (buffer-read-only case-fold-search query
|
|
|
1919 (help-form "\
|
|
|
1920 Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
|
|
|
1921 `!' to unflag all remaining files with no more questions."))
|
|
|
1922 (goto-char (point-min))
|
|
|
1923 (while (re-search-forward re nil t)
|
|
|
1924 (if (or (not arg)
|
|
|
1925 (dired-query 'query "Unflag file `%s' ? "
|
|
|
1926 (dired-get-filename t)))
|
|
|
1927 (progn (delete-char -1) (insert " ") (setq count (1+ count))))
|
|
|
1928 (forward-line 1))))
|
|
|
1929 (message "%s" (format "Flags removed: %d %s" count flag) )))
|
|
|
1930
|
|
|
1931 ;; pop ups and user input for file marking
|
|
|
1932
|
|
|
1933 (defun dired-marker-regexp ()
|
|
|
1934 (concat "^" (regexp-quote (char-to-string dired-marker-char))))
|
|
|
1935
|
|
|
1936 (defun dired-plural-s (count)
|
|
|
1937 (if (= 1 count) "" "s"))
|
|
|
1938
|
|
|
1939 (defun dired-mark-prompt (arg files)
|
|
|
1940 ;; Return a string for use in a prompt, either the current file
|
|
|
1941 ;; name, or the marker and a count of marked files.
|
|
|
1942 (let ((count (length files)))
|
|
|
1943 (if (= count 1)
|
|
|
1944 (car files)
|
|
|
1945 ;; more than 1 file:
|
|
|
1946 (if (integerp arg)
|
|
|
1947 ;; abs(arg) = count
|
|
|
1948 ;; Perhaps this is nicer, but it also takes more screen space:
|
|
|
1949 ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
|
|
|
1950 ;; count)
|
|
|
1951 (format "[next %d files]" arg)
|
|
|
1952 (format "%c [%d files]" dired-marker-char count)))))
|
|
|
1953
|
|
|
1954 (defvar dired-query-alist
|
|
|
1955 '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
|
|
|
1956 (?n . n) (?\177 . n) ; `n' or DEL skips once
|
|
|
1957 (?! . yes) ; `!' accepts rest
|
|
|
1958 (?q. no) (?\e . no) ; `q' or ESC skips rest
|
|
|
1959 ;; None of these keys quit - use C-g for that.
|
|
|
1960 ))
|
|
|
1961
|
|
|
1962 (defun dired-query (qs-var qs-prompt &rest qs-args)
|
|
|
1963 ;; Query user and return nil or t.
|
|
|
1964 ;; Store answer in symbol VAR (which must initially be bound to nil).
|
|
|
1965 ;; Format PROMPT with ARGS.
|
|
|
1966 ;; Binding variable help-form will help the user who types C-h.
|
|
|
1967 (let* ((char (symbol-value qs-var))
|
|
|
1968 (action (cdr (assoc char dired-query-alist))))
|
|
|
1969 (cond ((eq 'yes action)
|
|
|
1970 t) ; accept, and don't ask again
|
|
|
1971 ((eq 'no action)
|
|
|
1972 nil) ; skip, and don't ask again
|
|
|
1973 (t;; no lasting effects from last time we asked - ask now
|
|
|
1974 (let ((qprompt (concat qs-prompt
|
|
|
1975 (if help-form
|
|
|
1976 (format " [Type yn!q or %s] "
|
|
|
1977 (key-description
|
|
|
1978 (char-to-string help-char)))
|
|
|
1979 " [Type y, n, q or !] ")))
|
|
|
1980 result elt)
|
|
|
1981 ;; Actually it looks nicer without cursor-in-echo-area - you can
|
|
|
1982 ;; look at the dired buffer instead of at the prompt to decide.
|
|
|
1983 (apply 'message qprompt qs-args)
|
|
|
1984 (setq char (set qs-var (read-char)))
|
|
|
1985 (while (not (setq elt (assoc char dired-query-alist)))
|
|
|
1986 (message "Invalid char - type %c for help." help-char)
|
|
|
1987 (ding)
|
|
|
1988 (sit-for 1)
|
|
|
1989 (apply 'message qprompt qs-args)
|
|
|
1990 (setq char (set qs-var (read-char))))
|
|
|
1991 (memq (cdr elt) '(t y yes)))))))
|
|
|
1992
|
|
|
1993 (defun dired-pop-to-buffer (buf)
|
|
|
1994 ;; Pop up buffer BUF.
|
|
|
1995 ;; If dired-shrink-to-fit is t, make its window fit its contents.
|
|
|
1996 (if (not dired-shrink-to-fit)
|
|
|
1997 (pop-to-buffer (get-buffer-create buf))
|
|
|
1998 ;; let window shrink to fit:
|
|
|
1999 (let ((window (selected-window))
|
|
|
2000 target-lines w2)
|
|
|
2001 (cond ;; if split-window-threshold is enabled, use the largest window
|
|
|
2002 ((and (> (window-height (setq w2 (get-largest-window)))
|
|
|
2003 split-height-threshold)
|
|
|
2004 (= (screen-width) (window-width w2)))
|
|
|
2005 (setq window w2))
|
|
|
2006 ;; if the least-recently-used window is big enough, use it
|
|
|
2007 ((and (> (window-height (setq w2 (get-lru-window)))
|
|
|
2008 (* 2 window-min-height))
|
|
|
2009 (= (screen-width) (window-width w2)))
|
|
|
2010 (setq window w2)))
|
|
|
2011 (save-excursion
|
|
|
2012 (set-buffer buf)
|
|
|
2013 (goto-char (point-max))
|
|
|
2014 (skip-chars-backward "\n\r\t ")
|
|
|
2015 (setq target-lines (count-lines (point-min) (point))))
|
|
|
2016 (if (<= (window-height window) (* 2 window-min-height))
|
|
|
2017 ;; At this point, every window on the screen is too small to split.
|
|
|
2018 (setq w2 (display-buffer buf))
|
|
|
2019 (setq w2 (split-window window
|
|
|
2020 (max window-min-height
|
|
|
2021 (- (window-height window)
|
|
|
2022 (1+ (max window-min-height target-lines)))))))
|
|
|
2023 (set-window-buffer w2 buf)
|
|
|
2024 (if (< (1- (window-height w2)) target-lines)
|
|
|
2025 (progn
|
|
|
2026 (select-window w2)
|
|
|
2027 (enlarge-window (- target-lines (1- (window-height w2))))))
|
|
|
2028 (set-window-start w2 1)
|
|
|
2029 )))
|
|
|
2030
|
|
|
2031 (defvar dired-no-confirm nil
|
|
|
2032 ;; "If non-nil, list of symbols for commands dired should not confirm.
|
|
|
2033 ;;It can be a sublist of
|
|
|
2034 ;;
|
|
|
2035 ;; '(byte-compile chgrp chmod chown compress copy delete hardlink load
|
|
|
2036 ;; move print shell symlink uncompress)"
|
|
|
2037 )
|
|
|
2038
|
|
|
2039 (defun dired-mark-confirm (op-symbol arg)
|
|
|
2040 ;; Request confirmation from the user that the operation described
|
|
|
2041 ;; by OP-SYMBOL is to be performed on the marked files.
|
|
|
2042 ;; Confirmation consists in a y-or-n question with a file list
|
|
|
2043 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
|
|
|
2044 ;; The files used are determined by ARG (like in dired-mark-get-files).
|
|
|
2045 (or (memq op-symbol dired-no-confirm)
|
|
|
2046 (let ((files (dired-mark-get-files t arg)))
|
|
|
2047 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
|
|
|
2048 (concat (capitalize (symbol-name op-symbol)) " "
|
|
|
2049 (dired-mark-prompt arg files) "? ")))))
|
|
|
2050
|
|
|
2051 (defun dired-mark-pop-up (bufname op-symbol files function &rest args)
|
|
|
2052 ;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
|
|
|
2053 ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer
|
|
|
2054 ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked
|
|
|
2055 ;;files. Uses function `dired-pop-to-buffer' to do that.
|
|
|
2056 ;; FUNCTION should not manipulate files.
|
|
|
2057 ;; It should only read input (an argument or confirmation).
|
|
|
2058 ;;The window is not shown if there is just one file or
|
|
|
2059 ;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
|
|
|
2060 ;;FILES is the list of marked files."
|
|
|
2061 (or bufname (setq bufname " *Marked Files*"))
|
|
|
2062 (if (or (memq op-symbol dired-no-confirm)
|
|
|
2063 (= (length files) 1))
|
|
|
2064 (apply function args)
|
|
|
2065 (save-excursion
|
|
|
2066 (set-buffer (get-buffer-create bufname))
|
|
|
2067 (erase-buffer)
|
|
|
2068 (dired-format-columns-of-files files))
|
|
|
2069 (save-window-excursion
|
|
|
2070 (dired-pop-to-buffer bufname)
|
|
|
2071 (apply function args))))
|
|
|
2072
|
|
|
2073 (defun dired-format-columns-of-files (files)
|
|
|
2074 ;; Files should be in forward order for this loop.
|
|
|
2075 ;; i.e., (car files) = first file in buffer.
|
|
|
2076 ;; Returns the number of lines used.
|
|
|
2077 (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
|
|
|
2078 (width (- (window-width (selected-window)) 2))
|
|
|
2079 (columns (max 1 (/ width maxlen)))
|
|
|
2080 (nfiles (length files))
|
|
|
2081 (rows (+ (/ nfiles columns)
|
|
|
2082 (if (zerop (% nfiles columns)) 0 1)))
|
|
|
2083 (i 0)
|
|
|
2084 (j 0))
|
|
|
2085 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
2086 (make-list (- (* columns rows) nfiles) "")))
|
|
|
2087 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
2088 (while (< j rows)
|
|
|
2089 (while (< i columns)
|
|
|
2090 (indent-to (* i maxlen))
|
|
|
2091 (insert (car files))
|
|
|
2092 (setq files (nthcdr rows files)
|
|
|
2093 i (1+ i)))
|
|
|
2094 (insert "\n")
|
|
|
2095 (setq i 0
|
|
|
2096 j (1+ j)
|
|
|
2097 files (cdr files)))
|
|
|
2098 rows))
|
|
|
2099
|
|
|
2100 ;; Read arguments for a mark command of type OP-SYMBOL,
|
|
|
2101 ;; perhaps popping up the list of marked files.
|
|
|
2102 ;; ARG is the prefix arg and indicates whether the files came from
|
|
|
2103 ;; marks (ARG=nil) or a repeat factor (integerp ARG).
|
|
|
2104 ;; If the current file was used, the list has but one element and ARG
|
|
|
2105 ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
|
|
|
2106
|
|
|
2107 (defun dired-mark-read-string (prompt initial op-symbol arg files)
|
|
|
2108 ;; PROMPT for a string, with INITIAL input.
|
|
|
2109 ;; Other args are used to give user feedback and pop-up:
|
|
|
2110 ;; OP-SYMBOL of command, prefix ARG, marked FILES.
|
|
|
2111 (dired-mark-pop-up
|
|
|
2112 nil op-symbol files
|
|
|
2113 (function read-string)
|
|
|
2114 (format prompt (dired-mark-prompt arg files)) initial))
|
|
|
2115
|
|
|
2116 (defun dired-mark-read-file-name (prompt dir op-symbol arg files)
|
|
|
2117 (dired-mark-pop-up
|
|
|
2118 nil op-symbol files
|
|
|
2119 (function read-file-name)
|
|
|
2120 (format prompt (dired-mark-prompt arg files)) dir))
|
|
|
2121
|
|
|
2122 (defun dired-mark-file (arg)
|
|
|
2123 "In dired, mark the current line's file for later commands.
|
|
|
2124 With arg, repeat over several lines.
|
|
|
2125 Use \\[dired-unflag-all-files] to remove all flags."
|
|
|
2126 (interactive "p")
|
|
|
2127 (let (buffer-read-only)
|
|
|
2128 (dired-repeat-over-lines
|
|
|
2129 arg
|
|
|
2130 (function (lambda () (delete-char 1) (insert dired-marker-char))))))
|
|
|
2131
|
|
|
2132 (defun dired-next-marked-file (arg &optional wrap opoint)
|
|
|
2133 "Move to the next marked file, wrapping around the end of the buffer."
|
|
|
2134 (interactive "_p\np")
|
|
|
2135 (or opoint (setq opoint (point)));; return to where interactively started
|
|
|
2136 (if (if (> arg 0)
|
|
|
2137 (re-search-forward dired-re-mark nil t arg)
|
|
|
2138 (beginning-of-line)
|
|
|
2139 (re-search-backward dired-re-mark nil t (- arg)))
|
|
|
2140 (dired-move-to-filename)
|
|
|
2141 (if (null wrap)
|
|
|
2142 (progn
|
|
|
2143 (goto-char opoint)
|
|
|
2144 (error "No next marked file"))
|
|
|
2145 (message "(Wraparound for next marked file)")
|
|
|
2146 (goto-char (if (> arg 0) (point-min) (point-max)))
|
|
|
2147 (dired-next-marked-file arg nil opoint))))
|
|
|
2148
|
|
|
2149 (defun dired-prev-marked-file (arg &optional wrap)
|
|
|
2150 "Move to the previous marked file, wrapping around the end of the buffer."
|
|
|
2151 (interactive "_p\np")
|
|
|
2152 (dired-next-marked-file (- arg) wrap))
|
|
|
2153
|
|
|
2154 (defun dired-file-marker (file)
|
|
|
2155 ;; Return FILE's marker, or nil if unmarked.
|
|
|
2156 (save-excursion
|
|
|
2157 (and (dired-goto-file file)
|
|
|
2158 (progn
|
|
|
2159 (beginning-of-line)
|
|
|
2160 (if (not (equal ?\040 (following-char)))
|
|
|
2161 (following-char))))))
|
|
|
2162
|
|
|
2163 (defun dired-read-regexp (prompt &optional initial)
|
|
|
2164 ;; This is an extra function so that gmhist can redefine it.
|
|
|
2165 (setq dired-flagging-regexp
|
|
|
2166 (read-string prompt (or initial dired-flagging-regexp))))
|
|
|
2167
|
|
|
2168 (defun dired-mark-files-regexp (regexp &optional marker-char)
|
|
|
2169 "Mark all files matching REGEXP for use in later commands.
|
|
|
2170 A prefix argument means to unmark them instead.
|
|
|
2171 `.' and `..' are never marked.
|
|
|
2172
|
|
|
2173 REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
|
|
|
2174 object files--just `.o' will mark more than you might think."
|
|
|
2175 (interactive
|
|
|
2176 (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
|
|
|
2177 " files (regexp): "))
|
|
|
2178 (if current-prefix-arg ?\040)))
|
|
|
2179 (let ((dired-marker-char (or marker-char dired-marker-char)))
|
|
|
2180 (dired-mark-if
|
|
|
2181 (and (not (looking-at dired-re-dot))
|
|
|
2182 (not (eolp)) ; empty line
|
|
|
2183 (let ((fn (dired-get-filename nil t)))
|
|
|
2184 (and fn (string-match regexp (file-name-nondirectory fn)))))
|
|
|
2185 "matching file")))
|
|
|
2186
|
|
|
2187 (defun dired-flag-regexp-files (regexp)
|
|
|
2188 "In dired, flag all files containing the specified REGEXP for deletion.
|
|
|
2189 The match is against the non-directory part of the filename. Use `^'
|
|
|
2190 and `$' to anchor matches. Exclude subdirs by hiding them.
|
|
|
2191 `.' and `..' are never flagged."
|
|
|
2192 (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
|
|
|
2193 (dired-mark-files-regexp regexp dired-del-marker))
|
|
|
2194
|
|
|
2195 (defun dired-mark-symlinks (unflag-p)
|
|
|
2196 "Mark all symbolic links.
|
|
|
2197 With prefix argument, unflag all those files."
|
|
|
2198 (interactive "P")
|
|
|
2199 (dired-check-ls-l)
|
|
|
2200 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
|
|
|
2201 (dired-mark-if (looking-at dired-re-sym) "symbolic link")))
|
|
|
2202
|
|
|
2203 (defun dired-mark-directories (unflag-p)
|
|
|
2204 "Mark all directory file lines except `.' and `..'.
|
|
|
2205 With prefix argument, unflag all those files."
|
|
|
2206 (interactive "P")
|
|
|
2207 (dired-check-ls-l)
|
|
|
2208 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
|
|
|
2209 (dired-mark-if (and (looking-at dired-re-dir)
|
|
|
2210 (not (looking-at dired-re-dot)))
|
|
|
2211 "directory file")))
|
|
|
2212
|
|
|
2213 (defun dired-mark-executables (unflag-p)
|
|
|
2214 "Mark all executable files.
|
|
|
2215 With prefix argument, unflag all those files."
|
|
|
2216 (interactive "P")
|
|
|
2217 (dired-check-ls-l)
|
|
|
2218 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
|
|
|
2219 (dired-mark-if (looking-at dired-re-exe) "executable file")))
|
|
|
2220
|
|
|
2221 ;; dired-x.el has a dired-mark-sexp interactive command: mark
|
|
|
2222 ;; files for which PREDICATE returns non-nil.
|
|
|
2223
|
|
|
2224 (defun dired-flag-auto-save-files (&optional unflag-p)
|
|
|
2225 "Flag for deletion files whose names suggest they are auto save files.
|
|
|
2226 A prefix argument says to unflag those files instead."
|
|
|
2227 (interactive "P")
|
|
|
2228 (dired-check-ls-l)
|
|
|
2229 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
|
|
|
2230 (dired-mark-if
|
|
|
2231 (and (not (looking-at dired-re-dir))
|
|
|
2232 (let ((fn (dired-get-filename t t)))
|
|
|
2233 (if fn (auto-save-file-name-p
|
|
|
2234 (file-name-nondirectory fn)))))
|
|
|
2235 "auto save file")))
|
|
|
2236
|
|
|
2237 (defun dired-flag-backup-files (&optional unflag-p)
|
|
|
2238 "Flag all backup files (names ending with `~') for deletion.
|
|
|
2239 With prefix argument, unflag these files."
|
|
|
2240 (interactive "P")
|
|
|
2241 (dired-check-ls-l)
|
|
|
2242 (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
|
|
|
2243 (dired-mark-if
|
|
|
2244 (and (not (looking-at dired-re-dir))
|
|
|
2245 (let ((fn (dired-get-filename t t)))
|
|
|
2246 (if fn (backup-file-name-p fn))))
|
|
|
2247 "backup file")))
|
|
|
2248
|
|
|
2249
|
|
|
2250 ;;; Shell commands
|
|
|
2251 ;;#### install (move this function into simple.el)
|
|
|
2252 (defun shell-quote (filename) ; actually belongs into simple.el
|
|
|
2253 "Quote a file name for inferior shell (see variable shell-file-name)."
|
|
|
2254 ;; Quote everything except POSIX filename characters.
|
|
|
2255 ;; This should be safe enough even for really wierd shells.
|
|
|
2256 (let ((result "") (start 0) end)
|
|
|
2257 (while (string-match "[^---0-9a-zA-Z_./]" filename start)
|
|
|
2258 (setq end (match-beginning 0)
|
|
|
2259 result (concat result (substring filename start end)
|
|
|
2260 "\\" (substring filename end (1+ end)))
|
|
|
2261 start (1+ end)))
|
|
|
2262 (concat result (substring filename start))))
|
|
|
2263
|
|
|
2264 (defun dired-read-shell-command (prompt arg files)
|
|
|
2265 ;; "Read a dired shell command prompting with PROMPT (using read-string).
|
|
|
2266 ;;ARG is the prefix arg and may be used to indicate in the prompt which
|
|
|
2267 ;; files are affected.
|
|
|
2268 ;;This is an extra function so that you can redefine it, e.g., to use gmhist."
|
|
|
2269 (dired-mark-pop-up
|
|
|
2270 nil 'shell files
|
|
|
2271 (function read-string) (format prompt (dired-mark-prompt arg files))))
|
|
|
2272
|
|
|
2273 ;; The in-background argument is only needed in Emacs 18 where
|
|
|
2274 ;; shell-command doesn't understand an appended ampersand `&'.
|
|
|
2275 (defun dired-do-shell-command (&optional arg in-background)
|
|
|
2276 "Run a shell command on the marked files.
|
|
|
2277 If there is output, it goes to a separate buffer.
|
|
|
2278 The list of marked files is appended to the command string unless asterisks
|
|
|
2279 `*' indicate the place(s) where the list should go.
|
|
|
2280 If no files are marked or a specific numeric prefix arg is given, uses
|
|
|
2281 next ARG files. As always, a raw arg (\\[universal-argument]) means the current file.
|
|
|
2282 The prompt mentions the file(s) or the marker, as appropriate.
|
|
|
2283 With a zero argument, run command on each marked file separately: `cmd *
|
|
|
2284 foo' results in `cmd F1 foo; ...; cmd Fn foo'.
|
|
|
2285 No automatic redisplay is attempted, as the file names may have
|
|
|
2286 changed. Type \\[dired-do-redisplay] to redisplay the marked files.
|
|
|
2287 The shell command has the top level directory as working directory, so
|
|
|
2288 output files usually are created there instead of in a subdir."
|
|
|
2289 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
|
|
|
2290 ;;actual work and can be redefined for customization.
|
|
|
2291 (interactive "P")
|
|
|
2292 (let* ((on-each (equal arg 0))
|
|
|
2293 (prompt (concat (if in-background "& on " "! on ")
|
|
|
2294 (if on-each "each " "")
|
|
|
2295 "%s: "))
|
|
|
2296 (file-list (dired-mark-get-files t (if on-each nil arg)))
|
|
|
2297 ;; Want to give feedback whether this file or marked files are used:
|
|
|
2298 (command (dired-read-shell-command
|
|
|
2299 prompt (if on-each nil arg) file-list))
|
|
|
2300 (result
|
|
|
2301 (dired-shell-stuff-it command file-list on-each arg)))
|
|
|
2302 ;; execute the shell command
|
|
|
2303 (dired-run-shell-command result in-background)))
|
|
|
2304
|
|
|
2305 ;; Might use {,} for bash or csh:
|
|
|
2306 (defvar dired-mark-prefix ""
|
|
|
2307 "Prepended to marked files in dired shell commands.")
|
|
|
2308 (defvar dired-mark-postfix ""
|
|
|
2309 "Appended to marked files in dired shell commands.")
|
|
|
2310 (defvar dired-mark-separator " "
|
|
|
2311 "Separates marked files in dired shell commands.")
|
|
|
2312
|
|
|
2313 (defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
|
|
|
2314 ;; "Make up a shell command line from COMMAND and FILE-LIST.
|
|
|
2315 ;; If ON-EACH is t, COMMAND should be applied to each file, else
|
|
|
2316 ;; simply concat all files and apply COMMAND to this.
|
|
|
2317 ;; FILE-LIST's elements will be quoted for the shell."
|
|
|
2318 ;; Might be redefined for smarter things and could then use RAW-ARG
|
|
|
2319 ;; (coming from interactive P and currently ignored) to decide what to do.
|
|
|
2320 ;; Smart would be a way to access basename or extension of file names.
|
|
|
2321 ;; See dired-trns.el for an approach to this.
|
|
|
2322 ;; Bug: There is no way to quote a *
|
|
|
2323 ;; On the other hand, you can never accidentally get a * into your cmd.
|
|
|
2324 (let ((stuff-it
|
|
|
2325 (if (string-match "\\*" command)
|
|
|
2326 (function (lambda (x)
|
|
|
2327 (dired-replace-in-string "\\*" x command)))
|
|
|
2328 (function (lambda (x) (concat command " " x))))))
|
|
|
2329 (if on-each
|
|
|
2330 (mapconcat stuff-it (mapcar (function shell-quote) file-list) ";")
|
|
|
2331 (let ((fns (mapconcat (function shell-quote)
|
|
|
2332 file-list dired-mark-separator)))
|
|
|
2333 (if (> (length file-list) 1)
|
|
|
2334 (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
|
|
|
2335 (funcall stuff-it fns)))))
|
|
|
2336
|
|
|
2337 ;; This is an extra function so that it can be redefined by ange-ftp.
|
|
|
2338 (defun dired-run-shell-command (command &optional in-background)
|
|
|
2339 (if (and in-background (not (string-match "&[ \t]*$" command)))
|
|
|
2340 (setq command (concat command " &")))
|
|
|
2341 (shell-command command))
|
|
|
2342
|
|
|
2343 (defun dired-do-print (&optional arg)
|
|
|
2344 "Print the marked (or next ARG) files.
|
|
|
2345 Uses the shell command coming from variables `lpr-command' and
|
|
|
2346 `lpr-switches' as default."
|
|
|
2347 (interactive "P")
|
|
|
2348 (or (listp lpr-switches)
|
|
|
2349 (error "lpr-switches must be a *list* of strings"))
|
|
|
2350 (let* ((file-list (dired-mark-get-files t arg))
|
|
|
2351 (switches (mapconcat (function identity) lpr-switches " "))
|
|
|
2352 (command (dired-mark-read-string
|
|
|
2353 "Print %s with: "
|
|
|
2354 (concat lpr-command " " switches)
|
|
|
2355 'print arg file-list)))
|
|
|
2356 (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
|
|
|
2357
|
|
|
2358
|
|
|
2359 ;;; 10K
|
|
|
2360 ;;;###begin dired-cp.el
|
|
|
2361 ;;; Copy, move/rename, making hard and symbolic links
|
|
|
2362
|
|
|
2363 (defvar dired-backup-if-overwrite nil
|
|
|
2364 "*Non-nil if Dired should ask about making backups before overwriting files.
|
|
|
2365 Special value 'always suppresses confirmation.")
|
|
|
2366
|
|
|
2367 (defun dired-handle-overwrite (to)
|
|
|
2368 ;; Save old version of a to be overwritten file TO.
|
|
|
2369 ;; `overwrite-confirmed' and `overwrite-backup-query' are fluid vars
|
|
|
2370 ;; from dired-create-files.
|
|
|
2371 (if (and dired-backup-if-overwrite
|
|
|
2372 overwrite-confirmed
|
|
|
2373 (or (eq 'always dired-backup-if-overwrite)
|
|
|
2374 (dired-query 'overwrite-backup-query
|
|
|
2375 (format "Make backup for existing file `%s'? " to))))
|
|
|
2376 (let ((backup (car (find-backup-file-name to))))
|
|
|
2377 (rename-file to backup 0) ; confirm overwrite of old backup
|
|
|
2378 (dired-relist-entry backup))))
|
|
|
2379
|
|
|
2380 (defun dired-copy-file (from to ok-flag)
|
|
|
2381 (dired-handle-overwrite to)
|
|
|
2382 (copy-file from to ok-flag dired-copy-preserve-time))
|
|
|
2383
|
|
|
2384 (defun dired-rename-file (from to ok-flag)
|
|
|
2385 (dired-handle-overwrite to)
|
|
|
2386 (rename-file from to ok-flag) ; error is caught in -create-files
|
|
|
2387 ;; Silently rename the visited file of any buffer visiting this file.
|
|
|
2388 (and (get-file-buffer from)
|
|
|
2389 (save-excursion
|
|
|
2390 (set-buffer (get-file-buffer from))
|
|
|
2391 (let ((modflag (buffer-modified-p)))
|
|
|
2392 (set-visited-file-name to) ; kills write-file-hooks
|
|
|
2393 (set-buffer-modified-p modflag))))
|
|
|
2394 (dired-remove-file from)
|
|
|
2395 ;; See if it's an inserted subdir, and rename that, too.
|
|
|
2396 (dired-rename-subdir from to))
|
|
|
2397
|
|
|
2398 (defun dired-rename-subdir (from-dir to-dir)
|
|
|
2399 (setq from-dir (file-name-as-directory from-dir)
|
|
|
2400 to-dir (file-name-as-directory to-dir))
|
|
|
2401 (dired-fun-in-all-buffers from-dir
|
|
|
2402 (function dired-rename-subdir-1) from-dir to-dir)
|
|
|
2403 ;; Update visited file name of all affected buffers
|
|
|
2404 (let ((blist (buffer-list)))
|
|
|
2405 (while blist
|
|
|
2406 (save-excursion
|
|
|
2407 (set-buffer (car blist))
|
|
|
2408 (if (and buffer-file-name
|
|
|
2409 (dired-in-this-tree buffer-file-name from-dir))
|
|
|
2410 (let ((modflag (buffer-modified-p))
|
|
|
2411 (to-file (dired-replace-in-string
|
|
|
2412 (concat "^" (regexp-quote from-dir))
|
|
|
2413 to-dir
|
|
|
2414 buffer-file-name)))
|
|
|
2415 (set-visited-file-name to-file)
|
|
|
2416 (set-buffer-modified-p modflag))))
|
|
|
2417 (setq blist (cdr blist)))))
|
|
|
2418
|
|
|
2419 (defun dired-rename-subdir-1 (dir to)
|
|
|
2420 ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
|
|
|
2421 ;; one of its subdirectories is expanded in this buffer.
|
|
|
2422 (let ((alist dired-subdir-alist)
|
|
|
2423 (elt nil))
|
|
|
2424 (while alist
|
|
|
2425 (setq elt (car alist)
|
|
|
2426 alist (cdr alist))
|
|
|
2427 (if (dired-in-this-tree (car elt) dir)
|
|
|
2428 ;; ELT's subdir is affected by the rename
|
|
|
2429 (dired-rename-subdir-2 elt dir to)))
|
|
|
2430 (if (equal dir default-directory)
|
|
|
2431 ;; if top level directory was renamed, lots of things have to be
|
|
|
2432 ;; updated:
|
|
|
2433 (progn
|
|
|
2434 (dired-unadvertise dir) ; we no longer dired DIR...
|
|
|
2435 (setq default-directory to
|
|
|
2436 dired-directory (expand-file-name;; this is correct
|
|
|
2437 ;; with and without wildcards
|
|
|
2438 (file-name-nondirectory dired-directory)
|
|
|
2439 to))
|
|
|
2440 (let ((new-name (file-name-nondirectory
|
|
|
2441 (directory-file-name dired-directory))))
|
|
|
2442 ;; try to rename buffer, but just leave old name if new
|
|
|
2443 ;; name would already exist (don't try appending "<%d>")
|
|
|
2444 (or (get-buffer new-name)
|
|
|
2445 (rename-buffer new-name)))
|
|
|
2446 ;; ... we dired TO now:
|
|
|
2447 (dired-advertise)))))
|
|
|
2448
|
|
|
2449 (defun dired-rename-subdir-2 (elt dir to)
|
|
|
2450 ;; Update the headerline and dired-subdir-alist element of directory
|
|
|
2451 ;; described by alist-element ELT to reflect the moving of DIR to TO.
|
|
|
2452 ;; Thus, ELT describes either DIR itself or a subdir of DIR.
|
|
|
2453
|
|
|
2454 ;; Bug: If TO is not longer part of the same dired tree as DIR was,
|
|
|
2455 ;; updating the headerline is actually not the right thing---it
|
|
|
2456 ;; should be removed in that case and a completely new entry be
|
|
|
2457 ;; added for TO. Actually, removing and adding anew would always be
|
|
|
2458 ;; the right (but slow) way of doing it.
|
|
|
2459
|
|
|
2460 ;; The consequences are pretty harmless though (no updates since
|
|
|
2461 ;; dired-buffers-for-dir will not suspect it to be in this dired
|
|
|
2462 ;; buffer).
|
|
|
2463
|
|
|
2464 (save-excursion
|
|
|
2465 (let ((regexp (regexp-quote (directory-file-name dir)))
|
|
|
2466 (newtext (directory-file-name to))
|
|
|
2467 buffer-read-only)
|
|
|
2468 (goto-char (dired-get-subdir-min elt))
|
|
|
2469 ;; Update subdir headerline in buffer
|
|
|
2470 (if (not (looking-at dired-subdir-regexp))
|
|
|
2471 (error "%s not found where expected - dired-subdir-alist broken?"
|
|
|
2472 dir)
|
|
|
2473 (goto-char (match-beginning 1))
|
|
|
2474 (if (re-search-forward regexp (match-end 1) t)
|
|
|
2475 (replace-match newtext t t)
|
|
|
2476 (error "Expected to find `%s' in headerline of %s" dir (car elt))))
|
|
|
2477 ;; Update buffer-local dired-subdir-alist
|
|
|
2478 (setcar elt
|
|
|
2479 (dired-normalize-subdir
|
|
|
2480 (dired-replace-in-string regexp newtext (car elt)))))))
|
|
|
2481
|
|
|
2482 ;; Cloning replace-match to work on strings instead of in buffer:
|
|
|
2483 ;; The FIXEDCASE parameter of replace-match is not implemented.
|
|
|
2484 (defun dired-string-replace-match (regexp string newtext
|
|
|
2485 &optional literal global)
|
|
|
2486 "Replace first match of REGEXP in STRING with NEWTEXT.
|
|
|
2487 If it does not match, nil is returned instead of the new string.
|
|
|
2488 Optional arg LITERAL means to take NEWTEXT literally.
|
|
|
2489 Optional arg GLOBAL means to replace all matches."
|
|
|
2490 (if global
|
|
|
2491 (let ((result "") (start 0) mb me)
|
|
|
2492 (while (string-match regexp string start)
|
|
|
2493 (setq mb (match-beginning 0)
|
|
|
2494 me (match-end 0)
|
|
|
2495 result (concat result
|
|
|
2496 (substring string start mb)
|
|
|
2497 (if literal
|
|
|
2498 newtext
|
|
|
2499 (dired-expand-newtext string newtext)))
|
|
|
2500 start me))
|
|
|
2501 (if mb ; matched at least once
|
|
|
2502 (concat result (substring string start))
|
|
|
2503 nil))
|
|
|
2504 ;; not GLOBAL
|
|
|
2505 (if (not (string-match regexp string 0))
|
|
|
2506 nil
|
|
|
2507 (concat (substring string 0 (match-beginning 0))
|
|
|
2508 (if literal newtext (dired-expand-newtext string newtext))
|
|
|
2509 (substring string (match-end 0))))))
|
|
|
2510
|
|
|
2511 (defun dired-expand-newtext (string newtext)
|
|
|
2512 ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
|
|
|
2513 ;; Note that in Emacs 18 match data are clipped to current buffer
|
|
|
2514 ;; size...so the buffer should better not be smaller than STRING.
|
|
|
2515 (let ((pos 0)
|
|
|
2516 (len (length newtext))
|
|
|
2517 (expanded-newtext ""))
|
|
|
2518 (while (< pos len)
|
|
|
2519 (setq expanded-newtext
|
|
|
2520 (concat expanded-newtext
|
|
|
2521 (let ((c (aref newtext pos)))
|
|
|
2522 (if (= ?\\ c)
|
|
|
2523 (cond ((= ?\& (setq c
|
|
|
2524 (aref newtext
|
|
|
2525 (setq pos (1+ pos)))))
|
|
|
2526 (substring string
|
|
|
2527 (match-beginning 0)
|
|
|
2528 (match-end 0)))
|
|
|
2529 ((and (>= c ?1) (<= c ?9))
|
|
|
2530 ;; return empty string if N'th
|
|
|
2531 ;; sub-regexp did not match:
|
|
|
2532 (let ((n (- c ?0)))
|
|
|
2533 (if (match-beginning n)
|
|
|
2534 (substring string
|
|
|
2535 (match-beginning n)
|
|
|
2536 (match-end n))
|
|
|
2537 "")))
|
|
|
2538 (t
|
|
|
2539 (char-to-string c)))
|
|
|
2540 (char-to-string c)))))
|
|
|
2541 (setq pos (1+ pos)))
|
|
|
2542 expanded-newtext))
|
|
|
2543
|
|
|
2544 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
|
|
|
2545 (defun dired-create-files (file-creator operation fn-list name-constructor
|
|
|
2546 &optional marker-char)
|
|
|
2547
|
|
|
2548 ;; Create a new file for each from a list of existing files. The user
|
|
|
2549 ;; is queried, dired buffers are updated, and at the end a success or
|
|
|
2550 ;; failure message is displayed
|
|
|
2551
|
|
|
2552 ;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
|
|
|
2553
|
|
|
2554 ;; It is called for each file and must create newfile, the entry of
|
|
|
2555 ;; which will be added. The user will be queried if the file already
|
|
|
2556 ;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
|
|
|
2557 ;; rename), it is FILE-CREATOR's responsibility to update dired
|
|
|
2558 ;; buffers. FILE-CREATOR must abort by signalling a file-error if it
|
|
|
2559 ;; could not create newfile. The error is caught and logged.
|
|
|
2560
|
|
|
2561 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
|
|
|
2562 ;; operation performed. It is used for error logging.
|
|
|
2563
|
|
|
2564 ;; FN-LIST is the list of files to copy (full absolute pathnames).
|
|
|
2565
|
|
|
2566 ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
|
|
|
2567 ;; skip. If it skips files for other reasons than a direct user
|
|
|
2568 ;; query, it is supposed to tell why (using dired-log).
|
|
|
2569
|
|
|
2570 ;; Optional MARKER-CHAR is a character with which to mark every
|
|
|
2571 ;; newfile's entry, or t to use the current marker character if the
|
|
|
2572 ;; oldfile was marked.
|
|
|
2573
|
|
|
2574 (let (failures skipped (success-count 0) (total (length fn-list)))
|
|
|
2575 (let (to overwrite-query
|
|
|
2576 overwrite-backup-query) ; for dired-handle-overwrite
|
|
|
2577 (mapcar
|
|
|
2578 (function
|
|
|
2579 (lambda (from)
|
|
|
2580 (setq to (funcall name-constructor from))
|
|
|
2581 (if (equal to from)
|
|
|
2582 (progn
|
|
|
2583 (setq to nil)
|
|
|
2584 (dired-log "Cannot %s to same file: %s\n"
|
|
|
2585 (downcase operation) from)))
|
|
|
2586 (if (not to)
|
|
|
2587 (setq skipped (cons (dired-make-relative from) skipped))
|
|
|
2588 (let* ((overwrite (file-exists-p to))
|
|
|
2589 (overwrite-confirmed ; for dired-handle-overwrite
|
|
|
2590 (and overwrite
|
|
|
2591 (let ((help-form '(format "\
|
|
|
2592 Type SPC or `y' to overwrite file `%s',
|
|
|
2593 DEL or `n' to skip to next,
|
|
|
2594 ESC or `q' to not overwrite any of the remaining files,
|
|
|
2595 `!' to overwrite all remaining files with no more questions." to)))
|
|
|
2596 (dired-query 'overwrite-query
|
|
|
2597 "Overwrite `%s'?" to))))
|
|
|
2598 ;; must determine if FROM is marked before file-creator
|
|
|
2599 ;; gets a chance to delete it (in case of a move).
|
|
|
2600 (actual-marker-char
|
|
|
2601 (cond ((integerp marker-char) marker-char)
|
|
|
2602 (marker-char (dired-file-marker from)) ; slow
|
|
|
2603 (t nil))))
|
|
|
2604 (condition-case err
|
|
|
2605 (progn
|
|
|
2606 (funcall file-creator from to overwrite-confirmed)
|
|
|
2607 (if overwrite
|
|
|
2608 ;; If we get here, file-creator hasn't been aborted
|
|
|
2609 ;; and the old entry (if any) has to be deleted
|
|
|
2610 ;; before adding the new entry.
|
|
|
2611 (dired-remove-file to))
|
|
|
2612 (setq success-count (1+ success-count))
|
|
|
2613 (message "%s: %d of %d" operation success-count total)
|
|
|
2614 (dired-add-file to actual-marker-char))
|
|
|
2615 (file-error ; FILE-CREATOR aborted
|
|
|
2616 (progn
|
|
|
2617 (setq failures (cons (dired-make-relative from) failures))
|
|
|
2618 (dired-log "%s `%s' to `%s' failed:\n%s\n"
|
|
|
2619 operation from to err))))))))
|
|
|
2620 fn-list))
|
|
|
2621 (cond
|
|
|
2622 (failures
|
|
|
2623 (dired-log-summary
|
|
|
2624 (message "%s failed for %d of %d file%s %s"
|
|
|
2625 operation (length failures) total
|
|
|
2626 (dired-plural-s total) failures)))
|
|
|
2627 (skipped
|
|
|
2628 (dired-log-summary
|
|
|
2629 (message "%s: %d of %d file%s skipped %s"
|
|
|
2630 operation (length skipped) total
|
|
|
2631 (dired-plural-s total) skipped)))
|
|
|
2632 (t
|
|
|
2633 (message "%s: %s file%s."
|
|
|
2634 operation success-count (dired-plural-s success-count)))))
|
|
|
2635 (dired-move-to-filename))
|
|
|
2636
|
|
|
2637 (defun dired-do-create-files (op-symbol file-creator operation arg
|
|
|
2638 &optional marker-char op1
|
|
|
2639 how-to)
|
|
|
2640 ;; Create a new file for each marked file.
|
|
|
2641 ;; Prompts user for target, which is a directory in which to create
|
|
|
2642 ;; the new files. Target may be a plain file if only one marked
|
|
|
2643 ;; file exists.
|
|
|
2644 ;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
|
|
|
2645 ;; will determine wether pop-ups are appropriate for this OP-SYMBOL.
|
|
|
2646 ;; FILE-CREATOR and OPERATION as in dired-create-files.
|
|
|
2647 ;; ARG as in dired-mark-get-files.
|
|
|
2648 ;; Optional arg OP1 is an alternate form for OPERATION if there is
|
|
|
2649 ;; only one file.
|
|
|
2650 ;; Optional arg MARKER-CHAR as in dired-create-files.
|
|
|
2651 ;; Optional arg HOW-TO determines how to treat target:
|
|
|
2652 ;; If HOW-TO is not given (or nil), and target is a directory, the
|
|
|
2653 ;; file(s) are created inside the target directory. If target
|
|
|
2654 ;; is not a directory, there must be exactly one marked file,
|
|
|
2655 ;; else error.
|
|
|
2656 ;; If HOW-TO is t, then target is not modified. There must be
|
|
|
2657 ;; exactly one marked file, else error.
|
|
|
2658 ;; Else HOW-TO is assumed to be a function of one argument, target,
|
|
|
2659 ;; that looks at target and returns a value for the into-dir
|
|
|
2660 ;; variable. The function dired-into-dir-with-symlinks is provided
|
|
|
2661 ;; for the case (common when creating symlinks) that symbolic
|
|
|
2662 ;; links to directories are not to be considered as directories
|
|
|
2663 ;; (as file-directory-p would if HOW-TO had been nil).
|
|
|
2664 (or op1 (setq op1 operation))
|
|
|
2665 (let* ((fn-list (dired-mark-get-files nil arg))
|
|
|
2666 (fn-count (length fn-list))
|
|
|
2667 (target (expand-file-name
|
|
|
2668 (dired-mark-read-file-name
|
|
|
2669 (concat (if (= 1 fn-count) op1 operation) " %s to: ")
|
|
|
2670 (dired-dwim-target-directory)
|
|
|
2671 op-symbol arg (mapcar (function dired-make-relative) fn-list))))
|
|
|
2672 (into-dir (cond ((null how-to) (file-directory-p target))
|
|
|
2673 ((eq how-to t) nil)
|
|
|
2674 (t (funcall how-to target)))))
|
|
|
2675 (if (and (> fn-count 1)
|
|
|
2676 (not into-dir))
|
|
|
2677 (error "Marked %s: target must be a directory: %s" operation target))
|
|
|
2678 ;; rename-file bombs when moving directories unless we do this:
|
|
|
2679 (or into-dir (setq target (directory-file-name target)))
|
|
|
2680 (dired-create-files
|
|
|
2681 file-creator operation fn-list
|
|
|
2682 (if into-dir ; target is a directory
|
|
|
2683 ;; This function uses fluid vars into-dir and target when called
|
|
|
2684 ;; inside dired-create-files:
|
|
|
2685 (function (lambda (from)
|
|
|
2686 (expand-file-name (file-name-nondirectory from) target)))
|
|
|
2687 (function (lambda (from) target)))
|
|
|
2688 marker-char)))
|
|
|
2689
|
|
|
2690 (defun dired-dwim-target-directory ()
|
|
|
2691 ;; Try to guess which target directory the user may want.
|
|
|
2692 ;; If there is a dired buffer displayed in the next window, use
|
|
|
2693 ;; its current subdir, else use current subdir of this dired buffer.
|
|
|
2694 (let ((this-dir (and (eq major-mode 'dired-mode)
|
|
|
2695 (dired-current-directory))))
|
|
|
2696 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
|
|
|
2697 (if dired-dwim-target
|
|
|
2698 (let* ((other-buf (window-buffer (next-window)))
|
|
|
2699 (other-dir (save-excursion
|
|
|
2700 (set-buffer other-buf)
|
|
|
2701 (and (eq major-mode 'dired-mode)
|
|
|
2702 (dired-current-directory)))))
|
|
|
2703 (or other-dir this-dir))
|
|
|
2704 this-dir)))
|
|
|
2705
|
|
|
2706 (defun dired-into-dir-with-symlinks (target)
|
|
|
2707 (and (file-directory-p target)
|
|
|
2708 (not (file-symlink-p target))))
|
|
|
2709 ;; This may not always be what you want, especially if target is your
|
|
|
2710 ;; home directory and it happens to be a symbolic link, as is often the
|
|
|
2711 ;; case with NFS and automounters. Or if you want to make symlinks
|
|
|
2712 ;; into directories that themselves are only symlinks, also quite
|
|
|
2713 ;; common.
|
|
|
2714
|
|
|
2715 ;; So we don't use this function as value for HOW-TO in
|
|
|
2716 ;; dired-do-symlink, which has the minor disadvantage of
|
|
|
2717 ;; making links *into* a symlinked-dir, when you really wanted to
|
|
|
2718 ;; *overwrite* that symlink. In that (rare, I guess) case, you'll
|
|
|
2719 ;; just have to remove that symlink by hand before making your marked
|
|
|
2720 ;; symlinks.
|
|
|
2721
|
|
|
2722 (defun dired-do-copy (&optional arg)
|
|
|
2723 "Copy all marked (or next ARG) files, or copy the current file.
|
|
|
2724 Thus, a zero prefix argument copies nothing. But it toggles the
|
|
|
2725 variable `dired-copy-preserve-time' (which see)."
|
|
|
2726 (interactive "P")
|
|
|
2727 (if (not (zerop (prefix-numeric-value arg)))
|
|
|
2728 (dired-do-create-files 'copy (function dired-copy-file)
|
|
|
2729 (if dired-copy-preserve-time "Copy [-p]" "Copy")
|
|
|
2730 arg dired-keep-marker-copy)
|
|
|
2731 (setq dired-copy-preserve-time (not dired-copy-preserve-time))
|
|
|
2732 (if dired-copy-preserve-time
|
|
|
2733 (message "Copy will preserve time.")
|
|
|
2734 (message "Copied files will get current date."))))
|
|
|
2735
|
|
|
2736 (defun dired-do-symlink (&optional arg)
|
|
|
2737 "Symlink all marked (or next ARG) files into a directory,
|
|
|
2738 or make a symbolic link to the current file."
|
|
|
2739 (interactive "P")
|
|
|
2740 (dired-do-create-files 'symlink (function make-symbolic-link)
|
|
|
2741 "SymLink" arg dired-keep-marker-symlink))
|
|
|
2742
|
|
|
2743 (defun dired-do-hardlink (&optional arg)
|
|
|
2744 "Hard-link all marked (or next ARG) files into a directory,
|
|
|
2745 or make a hard link to the current file."
|
|
|
2746 (interactive "P")
|
|
|
2747 (dired-do-create-files 'hardlink (function add-name-to-file)
|
|
|
2748 "HardLink" arg dired-keep-marker-hardlink))
|
|
|
2749
|
|
|
2750 (defun dired-do-move (&optional arg)
|
|
|
2751 "Move all marked (or next ARG) files into a directory,
|
|
|
2752 or rename the current file.
|
|
|
2753 A zero ARG moves no files but toggles `dired-dwim-target' (which see)."
|
|
|
2754 (interactive "P")
|
|
|
2755 (if (not (zerop (prefix-numeric-value arg)))
|
|
|
2756 (dired-do-create-files 'move (function dired-rename-file)
|
|
|
2757 "Move" arg dired-keep-marker-move "Rename")
|
|
|
2758 (setq dired-dwim-target (not dired-dwim-target))
|
|
|
2759 (message "dired-dwim-target is %s." (if dired-dwim-target "ON" "OFF"))))
|
|
|
2760
|
|
|
2761 ;;;###end dired-cp.el
|
|
|
2762
|
|
|
2763 ;;; 5K
|
|
|
2764 ;;;###begin dired-re.el
|
|
|
2765 (defun dired-do-create-files-regexp
|
|
|
2766 (file-creator operation arg regexp newname &optional whole-path marker-char)
|
|
|
2767 ;; Create a new file for each marked file using regexps.
|
|
|
2768 ;; FILE-CREATOR and OPERATION as in dired-create-files.
|
|
|
2769 ;; ARG as in dired-mark-get-files.
|
|
|
2770 ;; Matches each marked file against REGEXP and constructs the new
|
|
|
2771 ;; filename from NEWNAME (like in function replace-match).
|
|
|
2772 ;; Optional arg WHOLE-PATH means match/replace the whole pathname
|
|
|
2773 ;; instead of only the non-directory part of the file.
|
|
|
2774 ;; Optional arg MARKER-CHAR as in dired-create-files.
|
|
|
2775 (let* ((fn-list (dired-mark-get-files nil arg))
|
|
|
2776 (fn-count (length fn-list))
|
|
|
2777 (operation-prompt (concat operation " `%s' to `%s'?"))
|
|
|
2778 (rename-regexp-help-form (format "\
|
|
|
2779 Type SPC or `y' to %s one match, DEL or `n' to skip to next,
|
|
|
2780 `!' to %s all remaining matches with no more questions."
|
|
|
2781 (downcase operation)
|
|
|
2782 (downcase operation)))
|
|
|
2783 (regexp-name-constructor
|
|
|
2784 ;; Function to construct new filename using REGEXP and NEWNAME:
|
|
|
2785 (if whole-path ; easy (but rare) case
|
|
|
2786 (function
|
|
|
2787 (lambda (from)
|
|
|
2788 (let ((to (dired-string-replace-match regexp from newname))
|
|
|
2789 ;; must bind help-form directly around call to
|
|
|
2790 ;; dired-query
|
|
|
2791 (help-form rename-regexp-help-form))
|
|
|
2792 (if to
|
|
|
2793 (and (dired-query 'rename-regexp-query
|
|
|
2794 operation-prompt
|
|
|
2795 from
|
|
|
2796 to)
|
|
|
2797 to)
|
|
|
2798 (dired-log "%s: %s did not match regexp %s\n"
|
|
|
2799 operation from regexp)))))
|
|
|
2800 ;; not whole-path, replace non-directory part only
|
|
|
2801 (function
|
|
|
2802 (lambda (from)
|
|
|
2803 (let* ((new (dired-string-replace-match
|
|
|
2804 regexp (file-name-nondirectory from) newname))
|
|
|
2805 (to (and new ; nil means there was no match
|
|
|
2806 (expand-file-name new
|
|
|
2807 (file-name-directory from))))
|
|
|
2808 (help-form rename-regexp-help-form))
|
|
|
2809 (if to
|
|
|
2810 (and (dired-query 'rename-regexp-query
|
|
|
2811 operation-prompt
|
|
|
2812 (dired-make-relative from)
|
|
|
2813 (dired-make-relative to))
|
|
|
2814 to)
|
|
|
2815 (dired-log "%s: %s did not match regexp %s\n"
|
|
|
2816 operation (file-name-nondirectory from) regexp)))))))
|
|
|
2817 rename-regexp-query)
|
|
|
2818 (dired-create-files
|
|
|
2819 file-creator operation fn-list regexp-name-constructor marker-char)))
|
|
|
2820
|
|
|
2821 (defun dired-mark-read-regexp (operation)
|
|
|
2822 ;; Prompt user about performing OPERATION.
|
|
|
2823 ;; Read and return list of: regexp newname arg whole-path.
|
|
|
2824 (let* ((whole-path
|
|
|
2825 (equal 0 (prefix-numeric-value current-prefix-arg)))
|
|
|
2826 (arg
|
|
|
2827 (if whole-path nil current-prefix-arg))
|
|
|
2828 (regexp
|
|
|
2829 (dired-read-regexp
|
|
|
2830 (concat (if whole-path "Path " "") operation " from (regexp): ")
|
|
|
2831 dired-flagging-regexp))
|
|
|
2832 (newname
|
|
|
2833 (read-string
|
|
|
2834 (concat (if whole-path "Path " "") operation " " regexp " to: "))))
|
|
|
2835 (list regexp newname arg whole-path)))
|
|
|
2836
|
|
|
2837 (defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
|
|
|
2838 "Rename marked files containing REGEXP to NEWNAME.
|
|
|
2839 As each match is found, the user must type a character saying
|
|
|
2840 what to do with it. For directions, type \\[help-command] at that time.
|
|
|
2841 NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
|
|
|
2842 REGEXP defaults to the last regexp used.
|
|
|
2843 With a zero prefix arg, renaming by regexp affects the complete
|
|
|
2844 pathname - usually only the non-directory part of file names is used
|
|
|
2845 and changed."
|
|
|
2846 (interactive (dired-mark-read-regexp "Rename"))
|
|
|
2847 (dired-do-create-files-regexp
|
|
|
2848 (function dired-rename-file)
|
|
|
2849 "Rename" arg regexp newname whole-path dired-keep-marker-move))
|
|
|
2850
|
|
|
2851 (defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
|
|
|
2852 "Copy all marked files containing REGEXP to NEWNAME.
|
|
|
2853 See function `dired-rename-regexp' for more info."
|
|
|
2854 (interactive (dired-mark-read-regexp "Copy"))
|
|
|
2855 (dired-do-create-files-regexp
|
|
|
2856 (function dired-copy-file)
|
|
|
2857 (if dired-copy-preserve-time "Copy [-p]" "Copy")
|
|
|
2858 arg regexp newname whole-path dired-keep-marker-copy))
|
|
|
2859
|
|
|
2860 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
|
|
|
2861 "Hardlink all marked files containing REGEXP to NEWNAME.
|
|
|
2862 See function `dired-rename-regexp' for more info."
|
|
|
2863 (interactive (dired-mark-read-regexp "HardLink"))
|
|
|
2864 (dired-do-create-files-regexp
|
|
|
2865 (function add-name-to-file)
|
|
|
2866 "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink))
|
|
|
2867
|
|
|
2868 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
|
|
|
2869 "Symlink all marked files containing REGEXP to NEWNAME.
|
|
|
2870 See function `dired-rename-regexp' for more info."
|
|
|
2871 (interactive (dired-mark-read-regexp "SymLink"))
|
|
|
2872 (dired-do-create-files-regexp
|
|
|
2873 (function make-symbolic-link)
|
|
|
2874 "SymLink" arg regexp newname whole-path dired-keep-marker-symlink))
|
|
|
2875
|
|
|
2876 (defun dired-create-files-non-directory
|
|
|
2877 (file-creator basename-constructor operation arg)
|
|
|
2878 ;; Perform FILE-CREATOR on the non-directory part of marked files
|
|
|
2879 ;; using function BASENAME-CONSTRUCTOR, with query for each file.
|
|
|
2880 ;; OPERATION like in dired-create-files, ARG like in dired-mark-get-files.
|
|
|
2881 (let (rename-non-directory-query)
|
|
|
2882 (dired-create-files
|
|
|
2883 file-creator
|
|
|
2884 operation
|
|
|
2885 (dired-mark-get-files nil arg)
|
|
|
2886 (function
|
|
|
2887 (lambda (from)
|
|
|
2888 (let ((to (concat (file-name-directory from)
|
|
|
2889 (funcall basename-constructor
|
|
|
2890 (file-name-nondirectory from)))))
|
|
|
2891 (and (let ((help-form (format "\
|
|
|
2892 Type SPC or `y' to %s one file, DEL or `n' to skip to next,
|
|
|
2893 `!' to %s all remaining matches with no more questions."
|
|
|
2894 (downcase operation)
|
|
|
2895 (downcase operation))))
|
|
|
2896 (dired-query 'rename-non-directory-query
|
|
|
2897 (concat operation " `%s' to `%s'")
|
|
|
2898 (dired-make-relative from)
|
|
|
2899 (dired-make-relative to)))
|
|
|
2900 to))))
|
|
|
2901 dired-keep-marker-move)))
|
|
|
2902
|
|
|
2903 (defun dired-rename-non-directory (basename-constructor operation arg)
|
|
|
2904 (dired-create-files-non-directory
|
|
|
2905 (function dired-rename-file)
|
|
|
2906 basename-constructor operation arg))
|
|
|
2907
|
|
|
2908 (defun dired-upcase (&optional arg)
|
|
|
2909 "Rename all marked (or next ARG) files to upper case."
|
|
|
2910 (interactive "P")
|
|
|
2911 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
|
|
|
2912
|
|
|
2913 (defun dired-downcase (&optional arg)
|
|
|
2914 "Rename all marked (or next ARG) files to lower case."
|
|
|
2915 (interactive "P")
|
|
|
2916 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
|
|
|
2917
|
|
|
2918 ;;;###end dired-re.el
|
|
|
2919
|
|
|
2920
|
|
|
2921 ;; Tree Dired
|
|
|
2922
|
|
|
2923 ;;; utility functions
|
|
|
2924
|
|
|
2925 (defun dired-in-this-tree (file dir)
|
|
|
2926 ;;"Is FILE part of the directory tree starting at DIR?"
|
|
|
2927 (let (case-fold-search)
|
|
|
2928 (string-match (concat "^" (regexp-quote dir)) file)))
|
|
|
2929
|
|
|
2930 (defun dired-make-absolute (file &optional dir)
|
|
|
2931 ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
|
|
|
2932 ;; We can't always use expand-file-name as this would get rid of `.'
|
|
|
2933 ;; or expand in / instead default-directory if DIR=="".
|
|
|
2934 ;; This should be good enough for ange-ftp, but might easily be
|
|
|
2935 ;; redefined (for VMS?).
|
|
|
2936 ;; It should be reasonably fast, though, as it is called in
|
|
|
2937 ;; dired-get-filename.
|
|
|
2938 (concat (or dir default-directory) file))
|
|
|
2939
|
|
|
2940 (defun dired-make-relative (file &optional dir no-error)
|
|
|
2941 ;;"Convert FILE (an absolute pathname) to a pathname relative to DIR.
|
|
|
2942 ;; Else error (unless NO-ERROR is non-nil, then FILE is returned unchanged)
|
|
|
2943 ;;DIR defaults to default-directory."
|
|
|
2944 ;; DIR must be file-name-as-directory, as with all directory args in
|
|
|
2945 ;; elisp code.
|
|
|
2946 (or dir (setq dir default-directory))
|
|
|
2947 (if (string-match (concat "^" (regexp-quote dir)) file)
|
|
|
2948 (substring file (match-end 0))
|
|
|
2949 (if no-error
|
|
|
2950 file
|
|
|
2951 (error "%s: not in directory tree growing at %s" file dir))))
|
|
|
2952
|
|
|
2953 (defun dired-normalize-subdir (dir)
|
|
|
2954 ;; Prepend default-directory to DIR if relative path name.
|
|
|
2955 ;; dired-get-filename must be able to make a valid filename from a
|
|
|
2956 ;; file and its directory DIR.
|
|
|
2957 (file-name-as-directory
|
|
|
2958 (if (file-name-absolute-p dir)
|
|
|
2959 dir
|
|
|
2960 (expand-file-name dir default-directory))))
|
|
|
2961
|
|
|
2962 (defun dired-between-files ()
|
|
|
2963 ;; Point must be at beginning of line
|
|
|
2964 ;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
|
|
|
2965 ;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
|
|
|
2966 (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard")
|
|
|
2967 (looking-at dired-subdir-regexp)))
|
|
|
2968
|
|
|
2969 (defun dired-get-subdir ()
|
|
|
2970 ;;"Return the subdir name on this line, or nil if not on a headerline."
|
|
|
2971 ;; Look up in the alist whether this is a headerline.
|
|
|
2972 (save-excursion
|
|
|
2973 (let ((cur-dir (dired-current-directory)))
|
|
|
2974 (beginning-of-line) ; alist stores b-o-l positions
|
|
|
2975 (and (zerop (- (point)
|
|
|
2976 (dired-get-subdir-min (assoc cur-dir
|
|
|
2977 dired-subdir-alist))))
|
|
|
2978 cur-dir))))
|
|
|
2979
|
|
|
2980 ;(defun dired-get-subdir-min (elt)
|
|
|
2981 ; (cdr elt))
|
|
|
2982 ;; can't use macro, must be redefinable for other alist format in dired-nstd.
|
|
|
2983 (fset 'dired-get-subdir-min 'cdr)
|
|
|
2984
|
|
|
2985 (defun dired-get-subdir-max (elt)
|
|
|
2986 (save-excursion
|
|
|
2987 (goto-char (dired-get-subdir-min elt))
|
|
|
2988 (dired-subdir-max)))
|
|
|
2989
|
|
|
2990 (defun dired-clear-alist ()
|
|
|
2991 (while dired-subdir-alist
|
|
|
2992 (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
|
|
|
2993 (setq dired-subdir-alist (cdr dired-subdir-alist))))
|
|
|
2994
|
|
|
2995 (defun dired-simple-subdir-alist ()
|
|
|
2996 ;; Build and return `dired-subdir-alist' assuming just the top level
|
|
|
2997 ;; directory to be inserted. Don't parse the buffer.
|
|
|
2998 (set (make-local-variable 'dired-subdir-alist)
|
|
|
2999 (list (cons default-directory (point-min-marker)))))
|
|
|
3000
|
|
|
3001 (defun dired-build-subdir-alist ()
|
|
|
3002 "Build `dired-subdir-alist' by parsing the buffer and return it's new value."
|
|
|
3003 (interactive)
|
|
|
3004 (dired-clear-alist)
|
|
|
3005 (save-excursion
|
|
|
3006 (let ((count 0))
|
|
|
3007 (goto-char (point-min))
|
|
|
3008 (setq dired-subdir-alist nil)
|
|
|
3009 (while (re-search-forward dired-subdir-regexp nil t)
|
|
|
3010 (setq count (1+ count))
|
|
|
3011 (dired-alist-add-1 (buffer-substring (match-beginning 1)
|
|
|
3012 (match-end 1))
|
|
|
3013 ;; Put subdir boundary between lines:
|
|
|
3014 (save-excursion
|
|
|
3015 (goto-char (match-beginning 0))
|
|
|
3016 (beginning-of-line)
|
|
|
3017 (point-marker)))
|
|
|
3018 (message "%d" count))
|
|
|
3019 (message "%d director%s." count (if (= 1 count) "y" "ies"))
|
|
|
3020 ;; We don't need to sort it because it is in buffer order per
|
|
|
3021 ;; constructionem. Return new alist:
|
|
|
3022 dired-subdir-alist)))
|
|
|
3023
|
|
|
3024 (defun dired-alist-add (dir new-marker)
|
|
|
3025 ;; Add new DIR at NEW-MARKER. Sort alist.
|
|
|
3026 (dired-alist-add-1 dir new-marker)
|
|
|
3027 (dired-alist-sort))
|
|
|
3028
|
|
|
3029 (defun dired-alist-add-1 (dir new-marker)
|
|
|
3030 ;; Add new DIR at NEW-MARKER. Don't sort.
|
|
|
3031 (setq dired-subdir-alist
|
|
|
3032 (cons (cons (dired-normalize-subdir dir) new-marker)
|
|
|
3033 dired-subdir-alist)))
|
|
|
3034
|
|
|
3035 (defun dired-alist-sort ()
|
|
|
3036 ;; Keep the alist sorted on buffer position.
|
|
|
3037 (setq dired-subdir-alist
|
|
|
3038 (sort dired-subdir-alist
|
|
|
3039 (function (lambda (elt1 elt2)
|
|
|
3040 (> (dired-get-subdir-min elt1)
|
|
|
3041 (dired-get-subdir-min elt2)))))))
|
|
|
3042
|
|
|
3043 (defun dired-unsubdir (dir)
|
|
|
3044 ;; Remove DIR from the alist
|
|
|
3045 (setq dired-subdir-alist
|
|
|
3046 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
|
|
|
3047
|
|
|
3048 (defun dired-goto-next-nontrivial-file ()
|
|
|
3049 ;; Position point on first nontrivial file after point.
|
|
|
3050 (dired-goto-next-file);; so there is a file to compare with
|
|
|
3051 (if (stringp dired-trivial-filenames)
|
|
|
3052 (while (and (not (eobp))
|
|
|
3053 (string-match dired-trivial-filenames
|
|
|
3054 (file-name-nondirectory
|
|
|
3055 (or (dired-get-filename nil t) ""))))
|
|
|
3056 (forward-line 1)
|
|
|
3057 (dired-move-to-filename))))
|
|
|
3058
|
|
|
3059 (defun dired-goto-next-file ()
|
|
|
3060 (let ((max (1- (dired-subdir-max))))
|
|
|
3061 (while (and (not (dired-move-to-filename)) (< (point) max))
|
|
|
3062 (forward-line 1))))
|
|
|
3063
|
|
|
3064 (defun dired-goto-subdir (dir)
|
|
|
3065 "Goto end of header line of DIR in this dired buffer.
|
|
|
3066 Return value of point on success, otherwise return nil.
|
|
|
3067 The next char is either \\n, or \\r if DIR is hidden."
|
|
|
3068 (interactive
|
|
|
3069 (prog1 ; let push-mark display its message
|
|
|
3070 (list (expand-file-name
|
|
|
3071 (completing-read "Goto in situ directory: " ; prompt
|
|
|
3072 dired-subdir-alist ; table
|
|
|
3073 nil ; predicate
|
|
|
3074 t ; require-match
|
|
|
3075 (dired-current-directory))))
|
|
|
3076 (push-mark)))
|
|
|
3077 (setq dir (file-name-as-directory dir))
|
|
|
3078 (let ((elt (assoc dir dired-subdir-alist)))
|
|
|
3079 (and elt
|
|
|
3080 (goto-char (dired-get-subdir-min elt))
|
|
|
3081 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
|
|
|
3082 ;; at either \r or \n after this function succeeds.
|
|
|
3083 (progn (skip-chars-forward "^\r\n")
|
|
|
3084 (point)))))
|
|
|
3085
|
|
|
3086 (defun dired-goto-file (file)
|
|
|
3087 "Goto file line of FILE in this dired buffer."
|
|
|
3088 ;; Return value of point on success, else nil.
|
|
|
3089 ;; FILE must be an absolute pathname.
|
|
|
3090 ;; Loses if FILE contains control chars like "\007" for which ls
|
|
|
3091 ;; either inserts "?" or "\\007" into the buffer, so we won't find
|
|
|
3092 ;; it in the buffer.
|
|
|
3093 (interactive
|
|
|
3094 (prog1 ; let push-mark display its message
|
|
|
3095 (list (expand-file-name
|
|
|
3096 (read-file-name "Goto file: "
|
|
|
3097 (dired-current-directory))))
|
|
|
3098 (push-mark)))
|
|
|
3099 (setq file (directory-file-name file)) ; does no harm if no directory
|
|
|
3100 (let (found case-fold-search)
|
|
|
3101 (save-excursion
|
|
|
3102 (if (dired-goto-subdir (or (file-name-directory file)
|
|
|
3103 (error "Need absolute pathname for %s" file)))
|
|
|
3104 (let ((base (file-name-nondirectory file))
|
|
|
3105 (boundary (dired-subdir-max)))
|
|
|
3106 (while (and (not found)
|
|
|
3107 ;; filenames are preceded by SPC, this makes
|
|
|
3108 ;; the search faster (e.g. for the filename "-"!).
|
|
|
3109 (search-forward (concat " " base) boundary 'move))
|
|
|
3110 ;; Match could have BASE just as initial substring or
|
|
|
3111 ;; or in permission bits or date or
|
|
|
3112 ;; not be a proper filename at all:
|
|
|
3113 (if (equal base (dired-get-filename 'no-dir t))
|
|
|
3114 ;; Must move to filename since an (actually
|
|
|
3115 ;; correct) match could have been elsewhere on the
|
|
|
3116 ;; ;; line (e.g. "-" would match somewhere in the
|
|
|
3117 ;; permission bits).
|
|
|
3118 (setq found (dired-move-to-filename)))))))
|
|
|
3119 (and found
|
|
|
3120 ;; return value of point (i.e., FOUND):
|
|
|
3121 (goto-char found))))
|
|
|
3122
|
|
|
3123 (defun dired-initial-position (dirname)
|
|
|
3124 ;; Where point should go in a new listing of DIRNAME.
|
|
|
3125 ;; Point assumed at beginning of new subdir line.
|
|
|
3126 ;; You may redefine this function as you wish, e.g. like in dired-x.el.
|
|
|
3127 (end-of-line)
|
|
|
3128 (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
|
|
|
3129
|
|
|
3130 ;;; moving by subdirectories
|
|
|
3131
|
|
|
3132 (defun dired-subdir-index (dir)
|
|
|
3133 ;; Return an index into alist for use with nth
|
|
|
3134 ;; for the sake of subdir moving commands.
|
|
|
3135 (let (found (index 0) (alist dired-subdir-alist))
|
|
|
3136 (while alist
|
|
|
3137 (if (string= dir (car (car alist)))
|
|
|
3138 (setq alist nil found t)
|
|
|
3139 (setq alist (cdr alist) index (1+ index))))
|
|
|
3140 (if found index nil)))
|
|
|
3141
|
|
|
3142 (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
|
|
|
3143 "Go to next subdirectory, regardless of level."
|
|
|
3144 ;; Use 0 arg to go to this directory's header line.
|
|
|
3145 ;; NO-SKIP prevents moving to end of header line, returning whatever
|
|
|
3146 ;; position was found in dired-subdir-alist.
|
|
|
3147 (interactive "_p")
|
|
|
3148 (let ((this-dir (dired-current-directory))
|
|
|
3149 pos index)
|
|
|
3150 ;; nth with negative arg does not return nil but the first element
|
|
|
3151 (setq index (- (dired-subdir-index this-dir) arg))
|
|
|
3152 (setq pos (if (>= index 0)
|
|
|
3153 (dired-get-subdir-min (nth index dired-subdir-alist))))
|
|
|
3154 (if pos
|
|
|
3155 (progn
|
|
|
3156 (goto-char pos)
|
|
|
3157 (or no-skip (skip-chars-forward "^\n\r"))
|
|
|
3158 (point))
|
|
|
3159 (if no-error-if-not-found
|
|
|
3160 nil ; return nil if not found
|
|
|
3161 (error "%s directory" (if (> arg 0) "Last" "First"))))))
|
|
|
3162
|
|
|
3163 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
|
|
|
3164 "Go to previous subdirectory, regardless of level.
|
|
|
3165 When called interactively and not on a subdir line, go to this subdir's line."
|
|
|
3166 ;;(interactive "_p")
|
|
|
3167 (interactive
|
|
|
3168 (list (if current-prefix-arg
|
|
|
3169 (prefix-numeric-value current-prefix-arg)
|
|
|
3170 ;; if on subdir start already, don't stay there!
|
|
|
3171 (if (dired-get-subdir) 1 0))))
|
|
|
3172 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
|
|
|
3173
|
|
|
3174 (defun dired-tree-up (arg)
|
|
|
3175 "Go up ARG levels in the dired tree."
|
|
|
3176 (interactive "_p")
|
|
|
3177 (let ((dir (dired-current-directory)))
|
|
|
3178 (while (>= arg 1)
|
|
|
3179 (setq arg (1- arg)
|
|
|
3180 dir (file-name-directory (directory-file-name dir))))
|
|
|
3181 ;;(setq dir (expand-file-name dir))
|
|
|
3182 (or (dired-goto-subdir dir)
|
|
|
3183 (error "Cannot go up to %s - not in this tree." dir))))
|
|
|
3184
|
|
|
3185 (defun dired-tree-down ()
|
|
|
3186 "Go down in the dired tree."
|
|
|
3187 (interactive "_")
|
|
|
3188 (let ((dir (dired-current-directory)) ; has slash
|
|
|
3189 pos case-fold-search) ; filenames are case sensitive
|
|
|
3190 (let ((rest (reverse dired-subdir-alist)) elt)
|
|
|
3191 (while rest
|
|
|
3192 (setq elt (car rest)
|
|
|
3193 rest (cdr rest))
|
|
|
3194 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
|
|
|
3195 (setq rest nil
|
|
|
3196 pos (dired-goto-subdir (car elt))))))
|
|
|
3197 (if pos
|
|
|
3198 (goto-char pos)
|
|
|
3199 (error "At the bottom"))))
|
|
|
3200
|
|
|
3201 ;;; hiding
|
|
|
3202
|
|
|
3203 (defun dired-subdir-hidden-p (dir)
|
|
|
3204 (and selective-display
|
|
|
3205 (save-excursion
|
|
|
3206 (dired-goto-subdir dir)
|
|
|
3207 (looking-at "\r"))))
|
|
|
3208
|
|
|
3209 (defun dired-unhide-subdir ()
|
|
|
3210 (let (buffer-read-only)
|
|
|
3211 (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
|
|
|
3212
|
|
|
3213 (defun dired-hide-check ()
|
|
|
3214 (or selective-display
|
|
|
3215 (error "selective-display must be t for subdir hiding to work!")))
|
|
|
3216
|
|
|
3217 (defun dired-hide-subdir (arg)
|
|
|
3218 "Hide or unhide the current subdirectory and move to next directory.
|
|
|
3219 Optional prefix arg is a repeat factor.
|
|
|
3220 Use \\[dired-hide-all] to (un)hide all directories."
|
|
|
3221 (interactive "p")
|
|
|
3222 (dired-hide-check)
|
|
|
3223 (while (>= (setq arg (1- arg)) 0)
|
|
|
3224 (let* ((cur-dir (dired-current-directory))
|
|
|
3225 (hidden-p (dired-subdir-hidden-p cur-dir))
|
|
|
3226 (elt (assoc cur-dir dired-subdir-alist))
|
|
|
3227 (end-pos (1- (dired-get-subdir-max elt)))
|
|
|
3228 buffer-read-only)
|
|
|
3229 ;; keep header line visible, hide rest
|
|
|
3230 (goto-char (dired-get-subdir-min elt))
|
|
|
3231 (skip-chars-forward "^\n\r")
|
|
|
3232 (if hidden-p
|
|
|
3233 (subst-char-in-region (point) end-pos ?\r ?\n)
|
|
|
3234 (subst-char-in-region (point) end-pos ?\n ?\r)))
|
|
|
3235 (dired-next-subdir 1 t)))
|
|
|
3236
|
|
|
3237 (defun dired-hide-all (arg)
|
|
|
3238 "Hide all subdirectories, leaving only their header lines.
|
|
|
3239 If there is already something hidden, make everything visible again.
|
|
|
3240 Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
|
|
|
3241 (interactive "P")
|
|
|
3242 (dired-hide-check)
|
|
|
3243 (let (buffer-read-only)
|
|
|
3244 (if (save-excursion
|
|
|
3245 (goto-char (point-min))
|
|
|
3246 (search-forward "\r" nil t))
|
|
|
3247 ;; unhide - bombs on \r in filenames
|
|
|
3248 (subst-char-in-region (point-min) (point-max) ?\r ?\n)
|
|
|
3249 ;; hide
|
|
|
3250 (let ((pos (point-max)) ; pos of end of last directory
|
|
|
3251 (alist dired-subdir-alist))
|
|
|
3252 (while alist ; while there are dirs before pos
|
|
|
3253 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
|
|
|
3254 (save-excursion
|
|
|
3255 (goto-char pos) ; current dir
|
|
|
3256 ;; we're somewhere on current dir's line
|
|
|
3257 (forward-line -1)
|
|
|
3258 (point))
|
|
|
3259 ?\n ?\r)
|
|
|
3260 (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
|
|
|
3261 (setq alist (cdr alist)))))))
|
|
|
3262
|
|
|
3263
|
|
|
3264 ;; This function is the heart of tree dired.
|
|
|
3265 ;; It is called for each retrieved filename.
|
|
|
3266 ;; It could stand to be faster, though it's mostly function call
|
|
|
3267 ;; overhead. Avoiding to funcall seems to save about 10% in
|
|
|
3268 ;; dired-get-filename. Make it a defsubst?
|
|
|
3269 (defun dired-current-directory (&optional localp)
|
|
|
3270 "Return the name of the subdirectory to which this line belongs.
|
|
|
3271 This returns a string with trailing slash, like `default-directory'.
|
|
|
3272 Optional argument means return a file name relative to `default-directory'."
|
|
|
3273 (let ((here (point))
|
|
|
3274 (alist (or dired-subdir-alist
|
|
|
3275 ;; probably because called in a non-dired buffer
|
|
|
3276 (error "No subdir-alist in %s" (current-buffer))))
|
|
|
3277 elt dir)
|
|
|
3278 (while alist
|
|
|
3279 (setq elt (car alist)
|
|
|
3280 dir (car elt)
|
|
|
3281 ;; use `<=' (not `<') as subdir line is part of subdir
|
|
|
3282 alist (if (<= (dired-get-subdir-min elt) here)
|
|
|
3283 nil ; found
|
|
|
3284 (cdr alist))))
|
|
|
3285 (if localp
|
|
|
3286 (dired-make-relative dir default-directory)
|
|
|
3287 dir)))
|
|
|
3288
|
|
|
3289 ;; Subdirs start at the beginning of their header lines and end just
|
|
|
3290 ;; before the beginning of the next header line (or end of buffer).
|
|
|
3291
|
|
|
3292 (defun dired-subdir-min ()
|
|
|
3293 (save-excursion
|
|
|
3294 (if (not (dired-prev-subdir 0 t t))
|
|
|
3295 (error "Not in a subdir!")
|
|
|
3296 (point))))
|
|
|
3297
|
|
|
3298 (defun dired-subdir-max ()
|
|
|
3299 (save-excursion
|
|
|
3300 (if (not (dired-next-subdir 1 t t))
|
|
|
3301 (point-max)
|
|
|
3302 (point))))
|
|
|
3303
|
|
|
3304 (defun dired-kill-line-or-subdir (&optional arg)
|
|
|
3305 "Kill this line (but not this file).
|
|
|
3306 Optional prefix argument is a repeat factor.
|
|
|
3307 If file is displayed as in situ subdir, kill that as well.
|
|
|
3308 If on a subdir headerline, kill whole subdir."
|
|
|
3309 (interactive "p")
|
|
|
3310 (if (dired-get-subdir)
|
|
|
3311 (dired-kill-subdir)
|
|
|
3312 (dired-kill-line arg)))
|
|
|
3313
|
|
|
3314 (defun dired-kill-line (&optional arg)
|
|
|
3315 (interactive "P")
|
|
|
3316 (setq arg (prefix-numeric-value arg))
|
|
|
3317 (let (buffer-read-only file)
|
|
|
3318 (while (/= 0 arg)
|
|
|
3319 (setq file (dired-get-filename nil t))
|
|
|
3320 (if (not file)
|
|
|
3321 (error "Can only kill file lines.")
|
|
|
3322 (save-excursion (and file
|
|
|
3323 (dired-goto-subdir file)
|
|
|
3324 (dired-kill-subdir)))
|
|
|
3325 (delete-region (progn (beginning-of-line) (point))
|
|
|
3326 (progn (forward-line 1) (point)))
|
|
|
3327 (if (> arg 0)
|
|
|
3328 (setq arg (1- arg))
|
|
|
3329 (setq arg (1+ arg))
|
|
|
3330 (forward-line -1))))
|
|
|
3331 (dired-move-to-filename)))
|
|
|
3332
|
|
|
3333 (defun dired-kill-subdir (&optional remember-marks)
|
|
|
3334 "Remove all lines of current subdirectory.
|
|
|
3335 Lower levels are unaffected."
|
|
|
3336 ;; With optional REMEMBER-MARKS, return a mark-alist.
|
|
|
3337 (interactive)
|
|
|
3338 (let ((beg (dired-subdir-min))
|
|
|
3339 (end (dired-subdir-max))
|
|
|
3340 buffer-read-only cur-dir)
|
|
|
3341 (setq cur-dir (dired-current-directory))
|
|
|
3342 (if (equal cur-dir default-directory)
|
|
|
3343 (error "Attempt to kill top level directory"))
|
|
|
3344 (prog1
|
|
|
3345 (if remember-marks (dired-remember-marks beg end))
|
|
|
3346 (delete-region beg end)
|
|
|
3347 (if (eobp) ; don't leave final blank line
|
|
|
3348 (delete-char -1))
|
|
|
3349 (dired-unsubdir cur-dir))))
|
|
|
3350
|
|
|
3351 (defun dired-do-kill (&optional arg fmt)
|
|
|
3352 "Kill all marked lines (not files).
|
|
|
3353 With a prefix arg, kill all lines not marked or flagged."
|
|
|
3354 ;; Returns count of killed lines. FMT="" suppresses message.
|
|
|
3355 (interactive "P")
|
|
|
3356 (save-excursion
|
|
|
3357 (goto-char (point-min))
|
|
|
3358 (let (buffer-read-only (count 0))
|
|
|
3359 (if (not arg) ; kill marked lines
|
|
|
3360 (let ((regexp (dired-marker-regexp)))
|
|
|
3361 (while (and (not (eobp))
|
|
|
3362 (re-search-forward regexp nil t))
|
|
|
3363 (setq count (1+ count))
|
|
|
3364 (delete-region (progn (beginning-of-line) (point))
|
|
|
3365 (progn (forward-line 1) (point)))))
|
|
|
3366 ;; else kill unmarked lines
|
|
|
3367 (while (not (eobp))
|
|
|
3368 (if (or (dired-between-files)
|
|
|
3369 (not (looking-at "^ ")))
|
|
|
3370 (forward-line 1)
|
|
|
3371 (setq count (1+ count))
|
|
|
3372 (delete-region (point) (save-excursion
|
|
|
3373 (forward-line 1)
|
|
|
3374 (point))))))
|
|
|
3375 (or (equal "" fmt)
|
|
|
3376 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
|
|
|
3377 count)))
|
|
|
3378
|
|
|
3379 (defun dired-do-redisplay (&optional arg test-for-subdir)
|
|
|
3380 "Redisplay all marked (or next ARG) files.
|
|
|
3381
|
|
|
3382 If on a subdir line, redisplay that subdirectory. In that case,
|
|
|
3383 a prefix arg lets you edit the ls switches used for the new listing."
|
|
|
3384 ;; Moves point if the next ARG files are redisplayed.
|
|
|
3385 (interactive "P\np")
|
|
|
3386 (if (and test-for-subdir (dired-get-subdir))
|
|
|
3387 (dired-insert-subdir
|
|
|
3388 (dired-get-subdir)
|
|
|
3389 (if arg (read-string "Switches for listing: " dired-actual-switches)))
|
|
|
3390 (message "Redisplaying...")
|
|
|
3391 ;; message instead of making dired-mark-map show-progress is much faster
|
|
|
3392 (dired-mark-map (let ((fname (dired-get-filename)))
|
|
|
3393 (message "Redisplaying... %s" fname)
|
|
|
3394 (dired-update-file-line fname))
|
|
|
3395 arg)
|
|
|
3396 (dired-move-to-filename)
|
|
|
3397 (message "Redisplaying...done")))
|
|
|
3398
|
|
|
3399 (defun dired-mark-files-in-region (start end)
|
|
|
3400 (let (buffer-read-only)
|
|
|
3401 (if (> start end)
|
|
|
3402 (error "start > end"))
|
|
|
3403 (goto-char start) ; assumed at beginning of line
|
|
|
3404 (while (< (point) end)
|
|
|
3405 ;; Skip subdir line and following garbage like the `total' line:
|
|
|
3406 (while (and (< (point) end) (dired-between-files))
|
|
|
3407 (forward-line 1))
|
|
|
3408 (if (and (not (looking-at dired-re-dot))
|
|
|
3409 (dired-get-filename nil t))
|
|
|
3410 (progn
|
|
|
3411 (delete-char 1)
|
|
|
3412 (insert dired-marker-char)))
|
|
|
3413 (forward-line 1))))
|
|
|
3414
|
|
|
3415 (defun dired-mark-subdir-files ()
|
|
|
3416 "Mark all files except `.' and `..'."
|
|
|
3417 (interactive "P")
|
|
|
3418 (let ((p-min (dired-subdir-min)))
|
|
|
3419 (dired-mark-files-in-region p-min (dired-subdir-max))))
|
|
|
3420
|
|
|
3421 (defun dired-mark-subdir-or-file (arg)
|
|
|
3422 "Mark the current (or next ARG) files.
|
|
|
3423 If on a subdir headerline, mark all its files except `.' and `..'.
|
|
|
3424
|
|
|
3425 Use \\[dired-unflag-all-files] to remove all marks
|
|
|
3426 and \\[dired-unmark-subdir-or-file] on a subdir to remove the marks in
|
|
|
3427 this subdir."
|
|
|
3428 (interactive "P")
|
|
|
3429 (if (dired-get-subdir)
|
|
|
3430 (save-excursion (dired-mark-subdir-files))
|
|
|
3431 (dired-mark-file (prefix-numeric-value arg))))
|
|
|
3432
|
|
|
3433 (defun dired-unmark-subdir-or-file (arg)
|
|
|
3434 "Unmark the current (or next ARG) files.
|
|
|
3435 If looking at a subdir, unmark all its files except `.' and `..'."
|
|
|
3436 (interactive "P")
|
|
|
3437 (let ((dired-marker-char ?\040))
|
|
|
3438 (dired-mark-subdir-or-file arg)))
|
|
|
3439
|
|
|
3440 ;;; 5K
|
|
|
3441 ;;;###begin dired-ins.el
|
|
|
3442
|
|
|
3443 (defun dired-maybe-insert-subdir (dirname &optional
|
|
|
3444 switches no-error-if-not-dir-p)
|
|
|
3445 "Insert this subdirectory into the same dired buffer.
|
|
|
3446 If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
|
|
|
3447 else inserts it at its natural place (as ls -lR would have done).
|
|
|
3448 With a prefix arg, you may edit the ls switches used for this listing.
|
|
|
3449 You can add `R' to the switches to expand the whole tree starting at
|
|
|
3450 this subdirectory.
|
|
|
3451 This function takes some pains to conform to ls -lR output."
|
|
|
3452 (interactive
|
|
|
3453 (list (dired-get-filename)
|
|
|
3454 (if current-prefix-arg
|
|
|
3455 (read-string "Switches for listing: " dired-actual-switches))))
|
|
|
3456 (let ((opoint (point)))
|
|
|
3457 ;; We don't need a marker for opoint as the subdir is always
|
|
|
3458 ;; inserted *after* opoint.
|
|
|
3459 (setq dirname (file-name-as-directory dirname))
|
|
|
3460 (or (and (not switches)
|
|
|
3461 (dired-goto-subdir dirname))
|
|
|
3462 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
|
|
|
3463 ;; Push mark so that it's easy to find back. Do this after the
|
|
|
3464 ;; insert message so that the user sees the `Mark set' message.
|
|
|
3465 (push-mark opoint)))
|
|
|
3466
|
|
|
3467 (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
|
|
|
3468 "Insert this subdirectory into the same dired buffer.
|
|
|
3469 If it is already present, overwrites previous entry,
|
|
|
3470 else inserts it at its natural place (as ls -lR would have done).
|
|
|
3471 With a prefix arg, you may edit the ls switches used for this listing.
|
|
|
3472 You can add `R' to the switches to expand the whole tree starting at
|
|
|
3473 this subdirectory.
|
|
|
3474 This function takes some pains to conform to ls -lR output."
|
|
|
3475 ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
|
|
|
3476 ;; Prospero where dired-ls does the right thing, but
|
|
|
3477 ;; file-directory-p has not been redefined.
|
|
|
3478 (interactive
|
|
|
3479 (list (dired-get-filename)
|
|
|
3480 (if current-prefix-arg
|
|
|
3481 (read-string "Switches for listing: " dired-actual-switches))))
|
|
|
3482 (setq dirname (file-name-as-directory (expand-file-name dirname)))
|
|
|
3483 (dired-insert-subdir-validate dirname switches)
|
|
|
3484 (or no-error-if-not-dir-p
|
|
|
3485 (file-directory-p dirname)
|
|
|
3486 (error "Attempt to insert a non-directory: %s" dirname))
|
|
|
3487 (let ((elt (assoc dirname dired-subdir-alist))
|
|
|
3488 switches-have-R mark-alist case-fold-search buffer-read-only)
|
|
|
3489 ;; case-fold-search is nil now, so we can test for capital `R':
|
|
|
3490 (if (setq switches-have-R (and switches (string-match "R" switches)))
|
|
|
3491 ;; avoid duplicated subdirs
|
|
|
3492 (setq mark-alist (dired-kill-tree dirname t)))
|
|
|
3493 (if elt
|
|
|
3494 ;; If subdir is already present, remove it and remember its marks
|
|
|
3495 (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
|
|
|
3496 (dired-insert-subdir-newpos dirname)) ; else compute new position
|
|
|
3497 (dired-insert-subdir-doupdate
|
|
|
3498 dirname elt (dired-insert-subdir-doinsert dirname switches))
|
|
|
3499 (if switches-have-R (dired-build-subdir-alist))
|
|
|
3500 (dired-initial-position dirname)
|
|
|
3501 (save-excursion (dired-mark-remembered mark-alist))))
|
|
|
3502
|
|
|
3503 ;; This is a separate function for dired-vms.
|
|
|
3504 (defun dired-insert-subdir-validate (dirname &optional switches)
|
|
|
3505 ;; Check that it is valid to insert DIRNAME with SWITCHES.
|
|
|
3506 ;; Signal an error if invalid (e.g. user typed `i' on `..').
|
|
|
3507 (or (dired-in-this-tree dirname default-directory)
|
|
|
3508 (error "%s: not in this directory tree" dirname))
|
|
|
3509 (if switches
|
|
|
3510 (let (case-fold-search)
|
|
|
3511 (mapcar
|
|
|
3512 (function
|
|
|
3513 (lambda (x)
|
|
|
3514 (or (eq (null (string-match x switches))
|
|
|
3515 (null (string-match x dired-actual-switches)))
|
|
|
3516 (error "Can't have dirs with and without -%s switches together"
|
|
|
3517 x))))
|
|
|
3518 ;; all switches that make a difference to dired-get-filename:
|
|
|
3519 '("F" "b")))))
|
|
|
3520
|
|
|
3521 (defun dired-kill-tree (dirname &optional remember-marks)
|
|
|
3522 ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
|
|
|
3523 ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
|
|
|
3524 (interactive "DKill tree below directory: ")
|
|
|
3525 (let ((s-alist dired-subdir-alist) dir m-alist)
|
|
|
3526 (while s-alist
|
|
|
3527 (setq dir (car (car s-alist))
|
|
|
3528 s-alist (cdr s-alist))
|
|
|
3529 (if (and (not (string-equal dir dirname))
|
|
|
3530 (dired-in-this-tree dir dirname)
|
|
|
3531 (dired-goto-subdir dir))
|
|
|
3532 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
|
|
|
3533 m-alist))
|
|
|
3534
|
|
|
3535 (defun dired-insert-subdir-newpos (new-dir)
|
|
|
3536 ;; Find pos for new subdir, according to tree order.
|
|
|
3537 (let ((alist dired-subdir-alist) elt dir pos new-pos)
|
|
|
3538 (while alist
|
|
|
3539 (setq elt (car alist)
|
|
|
3540 alist (cdr alist)
|
|
|
3541 dir (car elt)
|
|
|
3542 pos (dired-get-subdir-min elt))
|
|
|
3543 (if (dired-tree-lessp dir new-dir)
|
|
|
3544 ;; Insert NEW-DIR after DIR
|
|
|
3545 (setq new-pos (dired-get-subdir-max elt)
|
|
|
3546 alist nil)))
|
|
|
3547 (goto-char new-pos))
|
|
|
3548 ;; want a separating newline between subdirs
|
|
|
3549 (or (eobp)
|
|
|
3550 (forward-line -1))
|
|
|
3551 (insert "\n")
|
|
|
3552 (point))
|
|
|
3553
|
|
|
3554 (defun dired-insert-subdir-del (element)
|
|
|
3555 ;; Erase an already present subdir (given by ELEMENT) from buffer.
|
|
|
3556 ;; Move to that buffer position. Return a mark-alist.
|
|
|
3557 (let ((begin-marker (dired-get-subdir-min element)))
|
|
|
3558 (goto-char begin-marker)
|
|
|
3559 ;; Are at beginning of subdir (and inside it!). Now determine its end:
|
|
|
3560 (goto-char (dired-subdir-max))
|
|
|
3561 (or (eobp);; want a separating newline _between_ subdirs:
|
|
|
3562 (forward-char -1))
|
|
|
3563 (prog1
|
|
|
3564 (dired-remember-marks begin-marker (point))
|
|
|
3565 (delete-region begin-marker (point)))))
|
|
|
3566
|
|
|
3567 (defun dired-insert-subdir-doinsert (dirname switches)
|
|
|
3568 ;; Insert ls output after point and put point on the correct
|
|
|
3569 ;; position for the subdir alist.
|
|
|
3570 ;; Return the boundary of the inserted text (as list of BEG and END).
|
|
|
3571 (let ((begin (point)) end)
|
|
|
3572 (message "Reading directory %s..." dirname)
|
|
|
3573 (let ((dired-actual-switches
|
|
|
3574 (or switches
|
|
|
3575 (dired-replace-in-string "R" "" dired-actual-switches))))
|
|
|
3576 (if (equal dirname (car (car (reverse dired-subdir-alist))))
|
|
|
3577 ;; top level directory may contain wildcards:
|
|
|
3578 (dired-readin-insert dired-directory)
|
|
|
3579 (dired-ls dirname dired-actual-switches nil t)))
|
|
|
3580 (message "Reading directory %s...done" dirname)
|
|
|
3581 (setq end (point-marker))
|
|
|
3582 (dired-indent-rigidly begin end 2)
|
|
|
3583 ;; call dired-insert-headerline afterwards, as under VMS dired-ls
|
|
|
3584 ;; does insert the headerline itself and the insert function just
|
|
|
3585 ;; moves point.
|
|
|
3586 ;; Need a marker for END as this inserts text.
|
|
|
3587 (goto-char begin)
|
|
|
3588 (dired-insert-headerline dirname)
|
|
|
3589 ;; point is now like in dired-build-subdir-alist
|
|
|
3590 (prog1
|
|
|
3591 (list begin (marker-position end))
|
|
|
3592 (set-marker end nil))))
|
|
|
3593
|
|
|
3594 (defun dired-insert-subdir-doupdate (dirname elt beg-end)
|
|
|
3595 ;; Point is at the correct subdir alist position for ELT,
|
|
|
3596 ;; BEG-END is the subdir-region (as list of begin and end).
|
|
|
3597 (if elt ; subdir was already present
|
|
|
3598 ;; update its position (should actually be unchanged)
|
|
|
3599 (set-marker (dired-get-subdir-min elt) (point-marker))
|
|
|
3600 (dired-alist-add dirname (point-marker)))
|
|
|
3601 ;; The hook may depend on the subdir-alist containing the just
|
|
|
3602 ;; inserted subdir, so run it after dired-alist-add:
|
|
|
3603 (if dired-after-readin-hook
|
|
|
3604 (save-excursion
|
|
|
3605 (let ((begin (nth 0 beg-end))
|
|
|
3606 (end (nth 1 beg-end)))
|
|
|
3607 (goto-char begin)
|
|
|
3608 (save-restriction
|
|
|
3609 (narrow-to-region begin end)
|
|
|
3610 ;; hook may add or delete lines, but the subdir boundary
|
|
|
3611 ;; marker floats
|
|
|
3612 (run-hooks 'dired-after-readin-hook))))))
|
|
|
3613
|
|
|
3614 (defun dired-tree-lessp (dir1 dir2)
|
|
|
3615 ;; Lexicographic order on pathname components, like `ls -lR':
|
|
|
3616 ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
|
|
|
3617 ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
|
|
|
3618 ;; or DIR1 and DIR2 are in the same parentdir and their last
|
|
|
3619 ;; components are string-lessp.
|
|
|
3620 ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
|
|
|
3621 ;; string-lessp could arguably be replaced by file-newer-than-file-p
|
|
|
3622 ;; if dired-actual-switches contained `t'.
|
|
|
3623 (setq dir1 (file-name-as-directory dir1)
|
|
|
3624 dir2 (file-name-as-directory dir2))
|
|
|
3625 (let ((components-1 (dired-split "/" dir1))
|
|
|
3626 (components-2 (dired-split "/" dir2)))
|
|
|
3627 (while (and components-1
|
|
|
3628 components-2
|
|
|
3629 (equal (car components-1) (car components-2)))
|
|
|
3630 (setq components-1 (cdr components-1)
|
|
|
3631 components-2 (cdr components-2)))
|
|
|
3632 (let ((c1 (car components-1))
|
|
|
3633 (c2 (car components-2)))
|
|
|
3634
|
|
|
3635 (cond ((and c1 c2)
|
|
|
3636 (string-lessp c1 c2))
|
|
|
3637 ((and (null c1) (null c2))
|
|
|
3638 nil) ; they are equal, not lessp
|
|
|
3639 ((null c1) ; c2 is a subdir of c1: c1<c2
|
|
|
3640 t)
|
|
|
3641 ((null c2) ; c1 is a subdir of c2: c1>c2
|
|
|
3642 nil)
|
|
|
3643 (t (error "This can't happen"))))))
|
|
|
3644
|
|
|
3645 ;; There should be a builtin split function - inverse to mapconcat.
|
|
|
3646 (defun dired-split (pat str &optional limit)
|
|
|
3647 "Splitting on regexp PAT, turn string STR into a list of substrings.
|
|
|
3648 Optional third arg LIMIT (>= 1) is a limit to the length of the
|
|
|
3649 resulting list.
|
|
|
3650 Thus, if SEP is a regexp that only matches itself,
|
|
|
3651
|
|
|
3652 (mapconcat 'identity (dired-split SEP STRING) SEP)
|
|
|
3653
|
|
|
3654 is always equal to STRING."
|
|
|
3655 (let* ((start (string-match pat str))
|
|
|
3656 (result (list (substring str 0 start)))
|
|
|
3657 (count 1)
|
|
|
3658 (end (if start (match-end 0))))
|
|
|
3659 (if end ; else nothing left
|
|
|
3660 (while (and (or (not (integerp limit))
|
|
|
3661 (< count limit))
|
|
|
3662 (string-match pat str end))
|
|
|
3663 (setq start (match-beginning 0)
|
|
|
3664 count (1+ count)
|
|
|
3665 result (cons (substring str end start) result)
|
|
|
3666 end (match-end 0)
|
|
|
3667 start end)
|
|
|
3668 ))
|
|
|
3669 (if (and (or (not (integerp limit))
|
|
|
3670 (< count limit))
|
|
|
3671 end) ; else nothing left
|
|
|
3672 (setq result
|
|
|
3673 (cons (substring str end) result)))
|
|
|
3674 (nreverse result)))
|
|
|
3675
|
|
|
3676 (defun dired-indent-rigidly (start end arg)
|
|
|
3677 ;; like indent-rigidly but has more efficient behavior w.r.t. the
|
|
|
3678 ;; after-change-functions (i.e., font-lock-mode.)
|
|
|
3679 (save-excursion
|
|
|
3680 (let ((after-change-functions nil)
|
|
|
3681 (after-change-function nil))
|
|
|
3682 (goto-char end)
|
|
|
3683 (indent-rigidly start end arg))
|
|
|
3684 ;; deletion
|
|
|
3685 (run-hook-with-args 'after-change-functions start start (- end start))
|
|
|
3686 (run-hook-with-args 'after-change-function start start (- end start))
|
|
|
3687 ;; insertion
|
|
|
3688 (run-hook-with-args 'after-change-functions start (point) 0)
|
|
|
3689 (run-hook-with-args 'after-change-function start (point) 0)
|
|
|
3690 ))
|
|
|
3691
|
|
|
3692 (if (string-lessp emacs-version "19")
|
|
|
3693 (fset 'dired-indent-rigidly (symbol-function 'indent-rigidly)))
|
|
|
3694
|
|
|
3695 ;;;###end dired-ins.el
|
|
|
3696
|
|
|
3697
|
|
|
3698 ;;; Sorting
|
|
|
3699
|
|
|
3700 ;; Most ls can only sort by name or by date (with -t), nothing else.
|
|
|
3701 ;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
|
|
|
3702 ;; So anything that does not contain these is sort "by name".
|
|
|
3703
|
|
|
3704 (defvar dired-ls-sorting-switches "SXU"
|
|
|
3705 "String of ls switches (single letters) except `t' that influence sorting.")
|
|
|
3706
|
|
|
3707 (defvar dired-sort-by-date-regexp
|
|
|
3708 (concat "^-[^" dired-ls-sorting-switches
|
|
|
3709 "]*t[^" dired-ls-sorting-switches "]*$")
|
|
|
3710 "Regexp recognized by dired to set `by date' mode.")
|
|
|
3711
|
|
|
3712 (defvar dired-sort-by-name-regexp
|
|
|
3713 (concat "^-[^t" dired-ls-sorting-switches "]+$")
|
|
|
3714 "Regexp recognized by dired to set `by name' mode.")
|
|
|
3715
|
|
|
3716 (defvar dired-sort-mode nil
|
|
|
3717 "Whether Dired sorts by name, date etc. (buffer-local).")
|
|
|
3718 ;; This is nil outside dired buffers so it can be used in the modeline
|
|
|
3719
|
|
|
3720 (defun dired-sort-set-modeline ()
|
|
|
3721 ;; Set modeline display according to dired-actual-switches.
|
|
|
3722 ;; Modeline display of "by name" or "by date" guarantees the user a
|
|
|
3723 ;; match with the corresponding regexps. Non-matching switches are
|
|
|
3724 ;; shown literally.
|
|
|
3725 (setq dired-sort-mode
|
|
|
3726 (let (case-fold-search)
|
|
|
3727 (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
|
|
|
3728 " by name")
|
|
|
3729 ((string-match dired-sort-by-date-regexp dired-actual-switches)
|
|
|
3730 " by date")
|
|
|
3731 (t
|
|
|
3732 (concat " " dired-actual-switches)))))
|
|
|
3733 ;; update mode line:
|
|
|
3734 (set-buffer-modified-p (buffer-modified-p)))
|
|
|
3735
|
|
|
3736 (defun dired-sort-toggle-or-edit (&optional arg)
|
|
|
3737 "Toggle between sort by date/name and refresh the dired buffer.
|
|
|
3738 With a prefix argument you can edit the current listing switches instead."
|
|
|
3739 (interactive "P")
|
|
|
3740 (if arg
|
|
|
3741 (dired-sort-other
|
|
|
3742 (read-string "ls switches (must contain -l): " dired-actual-switches))
|
|
|
3743 (dired-sort-toggle)))
|
|
|
3744
|
|
|
3745 (defun dired-sort-toggle ()
|
|
|
3746 ;; Toggle between sort by date/name. Reverts the buffer.
|
|
|
3747 (setq dired-actual-switches
|
|
|
3748 (let (case-fold-search)
|
|
|
3749 (concat
|
|
|
3750 "-l"
|
|
|
3751 (dired-replace-in-string (concat "[---lt"
|
|
|
3752 dired-ls-sorting-switches "]")
|
|
|
3753 ""
|
|
|
3754 dired-actual-switches)
|
|
|
3755 (if (string-match (concat "[t" dired-ls-sorting-switches "]")
|
|
|
3756 dired-actual-switches)
|
|
|
3757 ""
|
|
|
3758 "t"))))
|
|
|
3759 (dired-sort-set-modeline)
|
|
|
3760 (revert-buffer))
|
|
|
3761
|
|
|
3762 (defun dired-sort-other (switches &optional no-revert)
|
|
|
3763 ;; Specify new ls SWITCHES for current dired buffer. Values matching
|
|
|
3764 ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the
|
|
|
3765 ;; minor mode accordingly, others appear literally in the mode line.
|
|
|
3766 ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
|
|
|
3767 (setq dired-actual-switches switches)
|
|
|
3768 (dired-sort-set-modeline)
|
|
|
3769 (or no-revert (revert-buffer)))
|
|
|
3770
|
|
|
3771 (if (eq system-type 'vax-vms)
|
|
|
3772 (load "dired-vms"))
|
|
|
3773
|
|
|
3774 (if (string-match "XEmacs" emacs-version)
|
|
|
3775 (load "dired-xemacs-menu"))
|
|
|
3776
|
|
|
3777 (run-hooks 'dired-load-hook) ; for your customizations
|
