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