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