|
0
|
1 ;;; dired-x.el --- Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19
|
|
|
2 ;; Keywords: dired extensions
|
|
|
3
|
|
|
4 (defconst dired-extra-version (substring "!Revision: 1.191 !" 11 -2)
|
|
|
5 "Id: dired-x.el,v 1.191 1992/05/14 11:41:54 sk RelBeta ")
|
|
|
6
|
|
|
7 ;; Copyright (C) 1991 Sebastian Kremer.
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
24
|
|
|
25 ;; LISPDIR ENTRY for the Elisp Archive ===============================
|
|
|
26 ;; LCD Archive Entry:
|
|
|
27 ;; dired-x|Sebastian Kremer|sk@thp.uni-koeln.de
|
|
|
28 ;; |Extra Features for Tree Dired
|
|
|
29 ;; |Date: 1992/05/14 11:41:54 |Revision: 1.191 |
|
|
|
30
|
|
|
31 ;; INSTALLATION ======================================================
|
|
|
32
|
|
|
33 ;; In your ~/.emacs, say
|
|
|
34 ;;
|
|
|
35 ;; (setq dired-load-hook '(lambda () (load "dired-x")))
|
|
|
36 ;;
|
|
|
37 ;; At load time dired-x will install itself using the various other
|
|
|
38 ;; dired hooks. It will redefine some functions and bind dired keys.
|
|
|
39 ;; If gmhist is present, dired-x will take advantage of it.
|
|
|
40
|
|
|
41 (require 'dired) ; we will redefine some functions
|
|
|
42 ; and also need some macros
|
|
|
43
|
|
|
44 (provide 'dired-extra) ; but this file is "dired-x"
|
|
|
45 (provide 'dired-x) ; but this file is "dired-x"
|
|
|
46
|
|
|
47 ;; Customization (see also defvars in other sections below)
|
|
|
48
|
|
|
49 ;; user should define this as `nil' prior to loading dired-x in order that the
|
|
|
50 ;; compression/decompression material of emacs19 is not overwritten.
|
|
|
51 (defvar dired-mark-keys '("Z")
|
|
|
52 "*List of keys (strings) that insert themselves as file markers.")
|
|
|
53
|
|
|
54 (defvar dired-dangerous-shell-command "^rm" ; e.g. "rm" or "rmdir"
|
|
|
55 "*Regexp for dangerous shell commands that should never be the default.")
|
|
|
56
|
|
|
57 ;; Add key bindings. This file is supposed to be loaded immediately
|
|
|
58 ;; after dired, inside dired-load-hook.
|
|
|
59
|
|
|
60 (define-key dired-mode-map "V" 'dired-vm)
|
|
|
61 (define-key dired-mode-map "\(" 'dired-set-marker-char)
|
|
|
62 (define-key dired-mode-map "\)" 'dired-restore-marker-char)
|
|
|
63 (define-key dired-mode-map "I" 'dired-do-insert-subdir)
|
|
|
64 ;;(define-key dired-mode-map "\M-f" 'dired-flag-extension)
|
|
|
65 (define-key dired-mode-map "\M-M" 'dired-do-unmark)
|
|
|
66 (define-key dired-mode-map "\M-o" 'dired-omit-toggle)
|
|
|
67 (define-key dired-mode-map "\M-(" 'dired-mark-sexp)
|
|
|
68 (define-key dired-mode-map "," 'dired-mark-rcs-files)
|
|
|
69 (define-key dired-mode-map "\M-!" 'dired-smart-shell-command)
|
|
|
70 (define-key dired-mode-map "\M-&" 'dired-smart-background-shell-command)
|
|
|
71 (define-key dired-mode-map "T" 'dired-do-toggle)
|
|
|
72 (define-key dired-mode-map "w" 'dired-copy-filename-as-kill)
|
|
|
73 (define-key dired-mode-map "\M-g" 'dired-goto-file)
|
|
|
74 (define-key dired-mode-map "\M-G" 'dired-goto-subdir)
|
|
|
75 (define-key dired-mode-map "&" 'dired-do-background-shell-command)
|
|
|
76 (define-key dired-mode-map "A" 'dired-do-byte-compile-and-load)
|
|
|
77 (define-key dired-mode-map "F" 'dired-do-find-file)
|
|
|
78 (define-key dired-mode-map "S" 'dired-do-relsymlink)
|
|
|
79 (define-key dired-mode-map "%S" 'dired-do-relsymlink-regexp)
|
|
|
80
|
|
|
81 (mapcar (function;; do this last to override bindings above
|
|
|
82 (lambda (x)
|
|
|
83 (define-key dired-mode-map x 'dired-mark-with-this-char)))
|
|
|
84 dired-mark-keys)
|
|
|
85
|
|
|
86 ;; Install ourselves into the appropriate hooks
|
|
|
87
|
|
|
88 (defun dired-add-hook (hook-var function)
|
|
|
89 "Add a function to a hook.
|
|
|
90 First argument HOOK-VAR (a symbol) is the name of a hook, second
|
|
|
91 argument FUNCTION is the function to add.
|
|
|
92 Returns nil if FUNCTION was already present in HOOK-VAR, else new
|
|
|
93 value of HOOK-VAR."
|
|
|
94 (interactive "SAdd to hook-var (symbol): \naAdd which function to %s? ")
|
|
|
95 (if (not (boundp hook-var)) (set hook-var nil))
|
|
|
96 (if (or (not (listp (symbol-value hook-var)))
|
|
|
97 (eq (car (symbol-value hook-var)) 'lambda))
|
|
|
98 (set hook-var (list (symbol-value hook-var))))
|
|
|
99 (if (memq function (symbol-value hook-var))
|
|
|
100 nil
|
|
|
101 (set hook-var (cons function (symbol-value hook-var)))))
|
|
|
102
|
|
|
103 (dired-add-hook 'dired-mode-hook 'dired-extra-startup)
|
|
|
104 (dired-add-hook 'dired-after-readin-hook 'dired-omit-expunge)
|
|
|
105
|
|
|
106 (defvar dired-default-marker dired-marker-char
|
|
|
107 "*The value of `dired-marker-char' in effect before dired-x was
|
|
|
108 loaded and the value which is restored if the marker stack underflows.
|
|
|
109 This is usually the asterisk `*'.")
|
|
|
110
|
|
|
111 ;;;###autoload
|
|
|
112 (defun dired-extra-startup ()
|
|
|
113 "Automatically put on dired-mode-hook to get extra dired features:
|
|
|
114 \\<dired-mode-map>
|
|
|
115 \\[dired-vm]\t-- VM on folder
|
|
|
116 \\[dired-rmail]\t-- Rmail on folder
|
|
|
117 \\[dired-do-insert-subdir]\t-- insert all marked subdirs
|
|
|
118 \\[dired-do-find-file]\t-- visit all marked files simultaneously
|
|
|
119 \\[dired-set-marker-char], \\[dired-restore-marker-char]\t-- change and display dired-marker-char dynamically.
|
|
|
120 \\[dired-omit-toggle]\t-- toggle omitting of files
|
|
|
121 \\[dired-mark-sexp]\t-- mark by lisp expression
|
|
|
122 \\[dired-do-unmark]\t-- replace existing marker with another.
|
|
|
123 \\[dired-mark-rcs-files]\t-- mark all RCS controlled files
|
|
|
124 \\[dired-mark-files-compilation-buffer]\t-- mark compilation files
|
|
|
125 \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring.
|
|
|
126 \t You can feed it to other commands using \\[yank].
|
|
|
127
|
|
|
128 For more features, see variables
|
|
|
129
|
|
|
130 dired-omit-files
|
|
|
131 dired-omit-extenstions
|
|
|
132 dired-dangerous-shell-command
|
|
|
133 dired-mark-keys
|
|
|
134 dired-local-variables-file
|
|
|
135 dired-find-subdir
|
|
|
136 dired-guess-have-gnutar
|
|
|
137 dired-auto-shell-command-alist
|
|
|
138
|
|
|
139 See also functions
|
|
|
140
|
|
|
141 dired-sort-on-size
|
|
|
142 dired-do-relsymlink
|
|
|
143 dired-flag-extension
|
|
|
144 dired-virtual
|
|
|
145 dired-jump-back
|
|
|
146 dired-jump-back-other-window
|
|
|
147 "
|
|
|
148 (interactive)
|
|
|
149 ;; This must be done in each new dired buffer:
|
|
|
150 (dired-hack-local-variables)
|
|
|
151 (dired-omit-startup)
|
|
|
152 (dired-marker-stack-startup))
|
|
|
153
|
|
|
154 ;;; Handle customization
|
|
|
155
|
|
|
156 (or (fboundp 'read-with-history-in) ; it's loaded
|
|
|
157 (not (subrp (symbol-function 'read-from-minibuffer))) ; it's 19.4L
|
|
|
158 ;; else try to load gmhist
|
|
|
159 (load "gmhist" t))
|
|
|
160
|
|
|
161 (if (not (fboundp 'read-with-history-in))
|
|
|
162
|
|
|
163 nil ; Gmhist is not available
|
|
|
164
|
|
|
165 ;; Else use generic minibuffer history
|
|
|
166 (put 'dired-shell-command-history 'dangerous dired-dangerous-shell-command)
|
|
|
167
|
|
|
168 ;; Redefinition - when this is loaded, dired.el has alreay been loaded.
|
|
|
169
|
|
|
170 (defun dired-read-regexp (prompt &optional initial)
|
|
|
171 (setq dired-flagging-regexp
|
|
|
172 (if (null initial)
|
|
|
173 (read-with-history-in 'regexp-history prompt initial)
|
|
|
174 (put 'regexp-history 'default
|
|
|
175 nil)
|
|
|
176 (put 'regexp-history 'default
|
|
|
177 (read-with-history-in 'regexp-history prompt initial)))))
|
|
|
178
|
|
|
179 (defun dired-read-dir-and-switches (str)
|
|
|
180 (nreverse
|
|
|
181 (list
|
|
|
182 (if current-prefix-arg
|
|
|
183 (read-string "Dired listing switches: " dired-listing-switches))
|
|
|
184 (read-file-name-with-history-in
|
|
|
185 'file-history ; or 'dired-history?
|
|
|
186 (format "Dired %s(directory): " str) nil default-directory nil))))
|
|
|
187 )
|
|
|
188
|
|
|
189
|
|
|
190
|
|
|
191 ;;; Dynamic Markers
|
|
|
192
|
|
|
193 (defun dired-mark-with-this-char (arg)
|
|
|
194 "Mark the current file or subdir with the last key you pressed to invoke
|
|
|
195 this command. Else like \\[dired-mark-subdir-or-file] command."
|
|
|
196 (interactive "p")
|
|
|
197 (let ((dired-marker-char;; use last character, in case of prefix cmd
|
|
|
198 last-command-char))
|
|
|
199 (dired-mark-subdir-or-file arg)))
|
|
|
200
|
|
|
201 (defvar dired-marker-stack nil
|
|
|
202 "List of previously used dired marker characters.")
|
|
|
203
|
|
|
204 (defvar dired-marker-string ""
|
|
|
205 "String version of `dired-marker-stack'.")
|
|
|
206
|
|
|
207 (defun dired-current-marker-string ()
|
|
|
208 "Computes and returns `dired-marker-string'."
|
|
|
209 (setq dired-marker-string
|
|
|
210 (concat " "
|
|
|
211 (mapconcat (function char-to-string)
|
|
|
212 (reverse dired-marker-stack)
|
|
|
213 ""))))
|
|
|
214
|
|
|
215 (defun dired-marker-stack-startup ()
|
|
|
216 (make-local-variable 'dired-marker-char)
|
|
|
217 (make-local-variable 'dired-del-marker)
|
|
|
218 (make-local-variable 'dired-marker-stack)
|
|
|
219 (or (assq 'dired-marker-stack minor-mode-alist)
|
|
|
220 (setq minor-mode-alist
|
|
|
221 (cons '(dired-marker-stack dired-marker-string)
|
|
|
222 minor-mode-alist))))
|
|
|
223
|
|
|
224 (defun dired-set-marker-char (c)
|
|
|
225 "Set the marker character to something else.
|
|
|
226 Use \\[dired-restore-marker-char] to restore the previous value."
|
|
|
227 (interactive "cNew marker character: ")
|
|
|
228 (setq dired-marker-stack (cons c dired-marker-stack))
|
|
|
229 (dired-current-marker-string)
|
|
|
230 (setq dired-marker-char c)
|
|
|
231 (set-buffer-modified-p (buffer-modified-p)) ; update mode line
|
|
|
232 (message "New marker is %c" dired-marker-char))
|
|
|
233
|
|
|
234 (defun dired-restore-marker-char ()
|
|
|
235 "Restore the marker character to its previous value.
|
|
|
236 Uses `dired-default-marker' if the marker stack is empty."
|
|
|
237 (interactive)
|
|
|
238 (setq dired-marker-stack (cdr dired-marker-stack)
|
|
|
239 dired-marker-char (car dired-marker-stack))
|
|
|
240 (dired-current-marker-string)
|
|
|
241 (set-buffer-modified-p (buffer-modified-p)) ; update mode line
|
|
|
242 (or dired-marker-char (setq dired-marker-char dired-default-marker))
|
|
|
243 (message "Marker is %c" dired-marker-char))
|
|
|
244
|
|
|
245 ;;; Sort on Size kludge if your ls can't do it
|
|
|
246
|
|
|
247 (defun dired-sort-on-size ()
|
|
|
248 "Sorts a dired listing on file size.
|
|
|
249 If your ls cannot sort on size, this is useful as `dired-after-readin-hook':
|
|
|
250 \(setq dired-after-readin-hook 'dired-sort-on-size\)"
|
|
|
251 (require 'sort)
|
|
|
252 (goto-char (point-min))
|
|
|
253 (dired-goto-next-file) ; skip `total' line
|
|
|
254 (beginning-of-line)
|
|
|
255 (sort-subr t ; biggest file first
|
|
|
256 'forward-line 'end-of-line 'dired-get-file-size))
|
|
|
257
|
|
|
258 (defun dired-get-file-size ()
|
|
|
259 (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)")
|
|
|
260 (goto-char (match-beginning 1))
|
|
|
261 (forward-char -1)
|
|
|
262 (string-to-int (buffer-substring (save-excursion
|
|
|
263 (backward-word 1)
|
|
|
264 (point))
|
|
|
265 (point))))
|
|
|
266
|
|
|
267
|
|
|
268 ;;; Misc. (mostly featurismic) commands
|
|
|
269
|
|
|
270 ;; Mail folders
|
|
|
271
|
|
|
272 (defvar dired-vm-read-only-folders nil
|
|
|
273 "*If t, \\[dired-vm] will visit all folders read-only.
|
|
|
274 If neither nil nor t, e.g. the symbol `if-file-read-only', only
|
|
|
275 files not writable by you are visited read-only.
|
|
|
276
|
|
|
277 Read-only folders only work in VM 5, not in VM 4.")
|
|
|
278
|
|
|
279 (defun dired-vm (&optional read-only)
|
|
|
280 "Run VM on this file.
|
|
|
281 With prefix arg, visit folder read-only (this requires at least VM 5).
|
|
|
282 See also variable `dired-vm-read-only-folders'."
|
|
|
283 (interactive "P")
|
|
|
284 (let ((dir (dired-current-directory))
|
|
|
285 (fil (dired-get-filename)))
|
|
|
286 ;; take care to supply 2nd arg only if requested - may still run VM 4!
|
|
|
287 (cond (read-only (vm-visit-folder fil t))
|
|
|
288 ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t))
|
|
|
289 ((null dired-vm-read-only-folders) (vm-visit-folder fil))
|
|
|
290 (t (vm-visit-folder fil (not (file-writable-p fil)))))
|
|
|
291 ;; so that pressing `v' inside VM does prompt within current directory:
|
|
|
292 (set (make-local-variable 'vm-folder-directory) dir)))
|
|
|
293
|
|
|
294 (defun dired-rmail ()
|
|
|
295 "Run RMAIL on this file."
|
|
|
296 (interactive)
|
|
|
297 (rmail (dired-get-filename)))
|
|
|
298
|
|
|
299 ;; More subdir operations
|
|
|
300
|
|
|
301 (defun dired-do-insert-subdir ()
|
|
|
302 "Insert all marked subdirectories in situ that are not yet inserted.
|
|
|
303 Non-directories are silently ignored."
|
|
|
304 (interactive)
|
|
|
305 (let ((files (or (dired-mark-get-files)
|
|
|
306 (error "No files marked."))))
|
|
|
307 (while files
|
|
|
308 (if (file-directory-p (car files))
|
|
|
309 (save-excursion (dired-maybe-insert-subdir (car files))))
|
|
|
310 (setq files (cdr files)))))
|
|
|
311
|
|
|
312 (defun dired-mark-extension (extension &optional marker-char)
|
|
|
313 "Mark all files with a certain extension for use in later commands.
|
|
|
314 A `.' is not automatically prepended to the string entered."
|
|
|
315 ;; EXTENSION may also be a list of extensions instead of a single one.
|
|
|
316 ;; Optional MARKER-CHAR is marker to use.
|
|
|
317 (interactive "sMarking extension: \nP")
|
|
|
318 (or (listp extension)
|
|
|
319 (setq extension (list extension)))
|
|
|
320 (dired-mark-files-regexp
|
|
|
321 (concat ".";; don't match names with nothing but an extension
|
|
|
322 "\\("
|
|
|
323 (mapconcat 'regexp-quote extension "\\|")
|
|
|
324 "\\)$")
|
|
|
325 marker-char))
|
|
|
326
|
|
|
327 (defun dired-flag-extension (extension)
|
|
|
328 "In dired, flag all files with a certain extension for deletion.
|
|
|
329 A `.' is *not* automatically prepended to the string entered."
|
|
|
330 (interactive "sFlagging extension: ")
|
|
|
331 (dired-mark-extension extension dired-del-marker))
|
|
|
332
|
|
|
333 (defvar patch-unclean-extensions
|
|
|
334 '(".rej" ".orig")
|
|
|
335 "List of extensions of dispensable files created by the `patch' program.")
|
|
|
336
|
|
|
337 (defvar tex-unclean-extensions
|
|
|
338 '(".toc" ".log" ".aux");; these are already in completion-ignored-extensions
|
|
|
339 "List of extensions of dispensable files created by TeX.")
|
|
|
340
|
|
|
341 (defvar latex-unclean-extensions
|
|
|
342 '(".idx" ".lof" ".lot" ".glo")
|
|
|
343 "List of extensions of dispensable files created by LaTeX.")
|
|
|
344
|
|
|
345 (defvar bibtex-unclean-extensions
|
|
|
346 '(".blg" ".bbl")
|
|
|
347 "List of extensions of dispensable files created by BibTeX.")
|
|
|
348
|
|
|
349 (defvar texinfo-unclean-extensions
|
|
|
350 '(".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs"
|
|
|
351 ".tp" ".tps" ".vr" ".vrs")
|
|
|
352 "List of extensions of dispensable files created by texinfo.")
|
|
|
353
|
|
|
354 (defun dired-clean-patch ()
|
|
|
355 "Flag dispensable files created by patch for deletion.
|
|
|
356 See variable `patch-unclean-extensions'."
|
|
|
357 (interactive)
|
|
|
358 (dired-flag-extension patch-unclean-extensions))
|
|
|
359
|
|
|
360 (defun dired-clean-tex ()
|
|
|
361 "Flag dispensable files created by tex etc. for deletion.
|
|
|
362 See variable `texinfo-unclean-extensions', `latex-unclean-extensions',
|
|
|
363 `bibtex-unclean-extensions' and `texinfo-unclean-extensions'."
|
|
|
364 (interactive)
|
|
|
365 (dired-flag-extension (append texinfo-unclean-extensions
|
|
|
366 latex-unclean-extensions
|
|
|
367 bibtex-unclean-extensions
|
|
|
368 tex-unclean-extensions)))
|
|
|
369
|
|
|
370 (defun dired-do-unmark (unmarker)
|
|
|
371 "Unmark marked files by replacing the marker with another character.
|
|
|
372 The new character defaults to a space, effectively unmarking them."
|
|
|
373 (interactive "sChange marker to: ")
|
|
|
374 (if (string= unmarker "")
|
|
|
375 (setq unmarker " "))
|
|
|
376 (setq unmarker (substring unmarker 0 1))
|
|
|
377 (let ((regexp (dired-marker-regexp))
|
|
|
378 (buffer-read-only nil))
|
|
|
379 (save-excursion
|
|
|
380 (goto-char (point-min))
|
|
|
381 (while (re-search-forward regexp nil t)
|
|
|
382 (replace-match unmarker)))))
|
|
|
383
|
|
|
384 ;; This is unused but might come in handy sometime
|
|
|
385 ;(defun dired-directories-of (files)
|
|
|
386 ; ;; Return unique list of parent directories of FILES.
|
|
|
387 ; (let (dirs dir file)
|
|
|
388 ; (while files
|
|
|
389 ; (setq file (car files)
|
|
|
390 ; files (cdr files)
|
|
|
391 ; dir (file-name-directory file))
|
|
|
392 ; (or (member dir dirs)
|
|
|
393 ; (setq dirs (cons dir dirs))))
|
|
|
394 ; dirs))
|
|
|
395
|
|
|
396 ;; Adapted from code by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
|
|
|
397 ;; Suggest you bind it to a key. I use C-x C-j.
|
|
|
398 (defun dired-jump-back (&optional other-window)
|
|
|
399 "Jump back to dired:
|
|
|
400 If in a file, dired the current directory and move to file's line.
|
|
|
401 If in dired already, pop up a level and goto old directory's line.
|
|
|
402 In case the proper dired file line cannot be found, refresh the dired
|
|
|
403 buffer and try again."
|
|
|
404 (interactive)
|
|
|
405 (let* ((file buffer-file-name)
|
|
|
406 (dir (if file (file-name-directory file) default-directory)))
|
|
|
407 (if (eq major-mode 'dired-mode)
|
|
|
408 (progn
|
|
|
409 (setq dir (dired-current-directory))
|
|
|
410 (if other-window
|
|
|
411 (dired-up-directory-other-window)
|
|
|
412 (dired-up-directory))
|
|
|
413 (dired-really-goto-file dir))
|
|
|
414 (if other-window
|
|
|
415 (dired-other-window dir)
|
|
|
416 (dired dir))
|
|
|
417 (if file (dired-really-goto-file file)))))
|
|
|
418
|
|
|
419 (defun dired-jump-back-other-window ()
|
|
|
420 "Like \\[dired-jump-back], but to other window."
|
|
|
421 (interactive)
|
|
|
422 (dired-jump-back t))
|
|
|
423
|
|
|
424 (defun dired-really-goto-file (file)
|
|
|
425 (or (dired-goto-file file)
|
|
|
426 (progn ; refresh and try again
|
|
|
427 (dired-insert-subdir (file-name-directory file))
|
|
|
428 (dired-goto-file file))))
|
|
|
429
|
|
|
430 (defun dired-up-directory-other-window ()
|
|
|
431 "Like `dired-up-directory', but in other window."
|
|
|
432 (interactive)
|
|
|
433 (let* ((dir (dired-current-directory))
|
|
|
434 (up (file-name-directory (directory-file-name dir))))
|
|
|
435 (or (dired-goto-file (directory-file-name dir))
|
|
|
436 (dired-goto-subdir up)
|
|
|
437 ;; Only in this case it really uses another window:
|
|
|
438 (progn
|
|
|
439 (dired-other-window up)
|
|
|
440 (dired-goto-file dir)))))
|
|
|
441
|
|
|
442 (defun dired-mark-rcs-files (&optional unflag-p)
|
|
|
443 "Mark all files that are under RCS control.
|
|
|
444 With prefix argument, unflag all those files.
|
|
|
445 Mentions RCS files for which a working file was not found in this buffer.
|
|
|
446 Type \\[dired-why] to see them again."
|
|
|
447 ;; Returns failures, or nil on success.
|
|
|
448 ;; Finding those with locks would require to peek into the ,v file,
|
|
|
449 ;; depends slightly on the RCS version used and should be done
|
|
|
450 ;; together with the Emacs RCS interface.
|
|
|
451 ;; Unfortunately, there is no definitive RCS interface yet.
|
|
|
452 (interactive "P")
|
|
|
453 (message "%sarking RCS controlled files..." (if unflag-p "Unm" "M"))
|
|
|
454 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char))
|
|
|
455 rcs-files wf failures count total)
|
|
|
456 (mapcar ; loop over subdirs
|
|
|
457 (function
|
|
|
458 (lambda (dir)
|
|
|
459 (or (equal (file-name-nondirectory (directory-file-name dir))
|
|
|
460 "RCS")
|
|
|
461 ;; skip inserted RCS subdirs
|
|
|
462 (setq rcs-files
|
|
|
463 (append (directory-files dir t ",v$") ; *,v and RCS/*,v
|
|
|
464 (let ((rcs-dir (expand-file-name "RCS" dir)))
|
|
|
465 (if (file-directory-p rcs-dir)
|
|
|
466 (mapcar ; working files from ./RCS are in ./
|
|
|
467 (function
|
|
|
468 (lambda (x)
|
|
|
469 (expand-file-name x dir)))
|
|
|
470 (directory-files
|
|
|
471 (file-name-as-directory rcs-dir) nil ",v$"))))
|
|
|
472 rcs-files)))))
|
|
|
473 (mapcar (function car) dired-subdir-alist))
|
|
|
474 (setq total (length rcs-files))
|
|
|
475 (while rcs-files
|
|
|
476 (setq wf (substring (car rcs-files) 0 -2)
|
|
|
477 rcs-files (cdr rcs-files))
|
|
|
478 (save-excursion (if (dired-goto-file wf)
|
|
|
479 (dired-mark-file 1)
|
|
|
480 (setq failures (cons wf failures)))))
|
|
|
481 (if (null failures)
|
|
|
482 (message "%d RCS file%s %smarked."
|
|
|
483 total (dired-plural-s total) (if unflag-p "un" ""))
|
|
|
484 (setq count (length failures))
|
|
|
485 (dired-log-summary "RCS working file not found %s" failures)
|
|
|
486 (message "%d RCS file%s: %d %smarked - %d not found %s."
|
|
|
487 total (dired-plural-s total) (- total count)
|
|
|
488 (if unflag-p "un" "") count failures))
|
|
|
489 failures))
|
|
|
490
|
|
|
491 (defun dired-do-toggle ()
|
|
|
492 "Toggle marks.
|
|
|
493 That is, currently marked files become unmarked and vice versa.
|
|
|
494 Files marked with other flags (such as `D') are not affected.
|
|
|
495 `.' and `..' are never toggled.
|
|
|
496 As always, hidden subdirs are not affected."
|
|
|
497 (interactive)
|
|
|
498 (save-excursion
|
|
|
499 (goto-char (point-min))
|
|
|
500 (let (buffer-read-only)
|
|
|
501 (while (not (eobp))
|
|
|
502 (or (dired-between-files)
|
|
|
503 (looking-at dired-re-dot)
|
|
|
504 ;; use subst instead of insdel because it does not move
|
|
|
505 ;; the gap and thus should be faster and because
|
|
|
506 ;; other characters are left alone automatically
|
|
|
507 (apply 'subst-char-in-region
|
|
|
508 (point) (1+ (point))
|
|
|
509 (if (eq ?\040 (following-char)) ; SPC
|
|
|
510 (list ?\040 dired-marker-char)
|
|
|
511 (list dired-marker-char ?\040))))
|
|
|
512 (forward-line 1)))))
|
|
|
513
|
|
|
514 ;; This function is missing in simple.el
|
|
|
515 (defun copy-string-as-kill (string)
|
|
|
516 "Save STRING as if killed in a buffer."
|
|
|
517 (setq kill-ring (cons string kill-ring))
|
|
|
518 (if (> (length kill-ring) kill-ring-max)
|
|
|
519 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
|
|
|
520 (setq kill-ring-yank-pointer kill-ring))
|
|
|
521
|
|
|
522 (defvar dired-marked-files nil
|
|
|
523 "List of filenames from last `dired-copy-filename-as-kill' call.")
|
|
|
524
|
|
|
525 (defun dired-copy-filename-as-kill (&optional arg)
|
|
|
526 "Copy names of marked (or next ARG) files into the kill ring.
|
|
|
527 The names are separated by a space.
|
|
|
528 With a zero prefix arg, use the complete pathname of each marked file.
|
|
|
529 With a raw (just \\[universal-argument]) prefix arg, use the relative pathname of each marked file.
|
|
|
530
|
|
|
531 If on a subdir headerline and no prefix arg given, use subdirname instead.
|
|
|
532
|
|
|
533 You can then feed the file name to other commands with \\[yank].
|
|
|
534
|
|
|
535 The list of names is also stored onto the variable
|
|
|
536 `dired-marked-files' for use, e.g., in an `\\[eval-expression]' command."
|
|
|
537 (interactive "P")
|
|
|
538 (copy-string-as-kill
|
|
|
539 (or (and (not arg)
|
|
|
540 (dired-get-subdir))
|
|
|
541 (mapconcat (function identity)
|
|
|
542 (setq dired-marked-files
|
|
|
543 (if arg
|
|
|
544 (cond ((zerop (prefix-numeric-value arg))
|
|
|
545 (dired-mark-get-files))
|
|
|
546 ((integerp arg)
|
|
|
547 (dired-mark-get-files 'no-dir arg))
|
|
|
548 (t ; else a raw arg
|
|
|
549 (dired-mark-get-files t)))
|
|
|
550 (dired-mark-get-files 'no-dir)))
|
|
|
551 " ")))
|
|
|
552 (message "%s" (car kill-ring)))
|
|
|
553
|
|
|
554 (defun dired-do-background-shell-command (&optional arg)
|
|
|
555 "Like \\[dired-do-shell-command], but starts command in background.
|
|
|
556 Note that you can type input to the command in its buffer.
|
|
|
557 This requires background.el from the comint package to work."
|
|
|
558 ;; With the version in emacs-19.el, you can alternatively just
|
|
|
559 ;; append an `&' to any shell command to make it run in the
|
|
|
560 ;; background, but you can't type input to it.
|
|
|
561 (interactive "P")
|
|
|
562 (dired-do-shell-command arg t))
|
|
|
563
|
|
|
564 ;; redefines dired.el to put back in the dired-offer-kill-buffer
|
|
|
565 ;; feature which rms didn't like.
|
|
|
566 (defun dired-clean-up-after-deletion (fn)
|
|
|
567 ;; Clean up after a deleted file or directory FN.
|
|
|
568 ;; Remove expanded subdir of deleted dir, if any
|
|
|
569 (save-excursion (and (dired-goto-subdir fn)
|
|
|
570 (dired-kill-subdir)))
|
|
|
571 ;; Offer to kill buffer of deleted file FN.
|
|
|
572 (let ((buf (get-file-buffer fn)))
|
|
|
573 (and buf
|
|
|
574 (funcall (function y-or-n-p)
|
|
|
575 (format "Kill buffer of %s, too? "
|
|
|
576 (file-name-nondirectory fn)))
|
|
|
577 (save-excursion;; you never know where kill-buffer leaves you
|
|
|
578 (kill-buffer buf))))
|
|
|
579 (let ((buf-list (dired-buffers-for-top-dir fn))
|
|
|
580 (buf nil))
|
|
|
581 (and buf-list
|
|
|
582 (y-or-n-p (format "Kill dired buffer%s of %s, too? "
|
|
|
583 (dired-plural-s (length buf-list))
|
|
|
584 (file-name-nondirectory fn)))
|
|
|
585 (while buf-list
|
|
|
586 (save-excursion (kill-buffer (car buf-list)))
|
|
|
587 (setq buf-list (cdr buf-list)))))
|
|
|
588 ;; Anything else?
|
|
|
589 )
|
|
|
590
|
|
|
591 ;;; Omitting
|
|
|
592
|
|
|
593 ;;; Enhanced omitting of lines from directory listings.
|
|
|
594 ;;; Marked files are never omitted.
|
|
|
595 ;;; Adapted from code submitted by:
|
|
|
596 ;;; Michael D. Ernst, mernst@theory.lcs.mit.edu, 1/11/91
|
|
|
597
|
|
|
598 (make-variable-buffer-local
|
|
|
599 (defvar dired-omit-files-p nil
|
|
|
600 "*If non-nil, \"uninteresting\" files are not listed (buffer-local).
|
|
|
601 Use \\[dired-omit-toggle] to toggle its value.
|
|
|
602 Uninteresting files are those whose filenames match regexp `dired-omit-files',
|
|
|
603 plus those ending with extensions in `dired-omit-extensions'."))
|
|
|
604
|
|
|
605 (defvar dired-omit-files "^#\\|\\.$"
|
|
|
606 "*Filenames matching this regexp will not be displayed (buffer-local).
|
|
|
607 This only has effect when `dired-omit-files-p' is t.
|
|
|
608 See also `dired-omit-extensions'.")
|
|
|
609
|
|
|
610 (defvar dired-omit-extensions
|
|
|
611 (append completion-ignored-extensions
|
|
|
612 latex-unclean-extensions
|
|
|
613 bibtex-unclean-extensions
|
|
|
614 texinfo-unclean-extensions)
|
|
|
615 "*If non-nil, a list of extensions (strings) to omit from Dired
|
|
|
616 listings. Defaults to the elements of
|
|
|
617 `completion-ignored-extensions', `latex-unclean-extensions',
|
|
|
618 `bibtex-unclean-extensions' and `texinfo-unclean-extensions'.")
|
|
|
619
|
|
|
620 ;; should probably get rid of this and always use 'no-dir.
|
|
|
621 ;; sk 28-Aug-1991 09:37
|
|
|
622 (defvar dired-omit-localp 'no-dir
|
|
|
623 "The LOCALP argument dired-omit-expunge passes to dired-get-filename.
|
|
|
624 If it is 'no-dir, omitting is much faster, but you can only match
|
|
|
625 against the basename of the file. Set it to nil if you need to match the
|
|
|
626 whole pathname.")
|
|
|
627
|
|
|
628 ;; \017=^O for Omit - other packages can chose other control characters.
|
|
|
629 (defvar dired-omit-marker-char ?\017
|
|
2
|
630 "Temporary marker used by dired-omit.
|
|
|
631 Should never be used as a marker by the user or other packages.")
|
|
0
|
632
|
|
|
633 (defun dired-omit-startup ()
|
|
|
634 (or (assq 'dired-omit-files-p minor-mode-alist)
|
|
|
635 ;; Append at end so that it doesn't get between "Dired" and "by name".
|
|
|
636 (setq minor-mode-alist
|
|
|
637 (append minor-mode-alist '((dired-omit-files-p " Omit"))))))
|
|
|
638
|
|
|
639 (defun dired-omit-toggle (&optional flag)
|
|
|
640 "Toggle between displaying and omitting files matching `dired-omit-files'.
|
|
|
641 With an arg, and if omitting was off, don't toggle and just mark the
|
|
|
642 files but don't actually omit them.
|
|
|
643 With an arg, and if omitting was on, turn it off but don't refresh the buffer."
|
|
|
644 (interactive "P")
|
|
|
645 (if flag
|
|
|
646 (if dired-omit-files-p
|
|
|
647 (setq dired-omit-files-p (not dired-omit-files-p))
|
|
|
648 (dired-mark-unmarked-files (dired-omit-regexp) nil nil
|
|
|
649 dired-omit-localp))
|
|
|
650 ;; no FLAG
|
|
|
651 (setq dired-omit-files-p (not dired-omit-files-p))
|
|
|
652 (if (not dired-omit-files-p)
|
|
|
653 (revert-buffer)
|
|
|
654 ;; this will mention how many were omitted:
|
|
|
655 (dired-omit-expunge))))
|
|
|
656
|
|
|
657 ;; This is sometimes let-bound to t if messages would be annoying,
|
|
|
658 ;; e.g., in dired-awrh.el.
|
|
|
659 (defvar dired-omit-silent nil)
|
|
|
660
|
|
|
661 ;; in emacs19 `(dired-do-kill)' is called `(dired-do-kill-lines)'
|
|
|
662 (if (fboundp 'dired-do-kill-lines)
|
|
|
663 (fset 'dired-do-kill 'dired-do-kill-lines))
|
|
|
664
|
|
|
665 (defun dired-omit-expunge (&optional regexp)
|
|
|
666 "Erases all unmarked files matching REGEXP.
|
|
|
667 Does nothing if global variable `dired-omit-files-p' is nil.
|
|
|
668 If REGEXP is nil or not specified, uses `dired-omit-files', and also omits
|
|
|
669 filenames ending in `dired-omit-extensions'.
|
|
|
670 If REGEXP is the empty string, this function is a no-op.
|
|
|
671
|
|
|
672 This functions works by temporarily binding `dired-marker-char' to
|
|
|
673 `dired-omit-marker-char' and calling `dired-do-kill'."
|
|
|
674 (interactive "sOmit files (regexp): ")
|
|
|
675 (if dired-omit-files-p
|
|
|
676 (let ((omit-re (or regexp (dired-omit-regexp)))
|
|
|
677 count)
|
|
|
678 (or (string= omit-re "")
|
|
|
679 (let ((dired-marker-char dired-omit-marker-char))
|
|
|
680 (or dired-omit-silent (message "Omitting..."))
|
|
|
681 (if (dired-mark-unmarked-files
|
|
|
682 omit-re nil nil dired-omit-localp)
|
|
|
683 (setq count (dired-do-kill nil (if dired-omit-silent
|
|
|
684 ""
|
|
|
685 "Omitted %d line%s.")))
|
|
|
686 (or dired-omit-silent
|
|
|
687 (message "(Nothing to omit)")))))
|
|
|
688 count)))
|
|
|
689
|
|
|
690 (defun dired-omit-regexp ()
|
|
|
691 (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
|
|
|
692 (if (and dired-omit-files dired-omit-extensions) "\\|" "")
|
|
|
693 (if dired-omit-extensions
|
|
|
694 (concat ".";; a non-extension part should exist
|
|
|
695 "\\("
|
|
|
696 (mapconcat 'regexp-quote dired-omit-extensions "\\|")
|
|
|
697 "\\)$")
|
|
|
698 "")))
|
|
|
699
|
|
|
700 ;; Returns t if any work was done, nil otherwise.
|
|
|
701 (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
|
|
|
702 "Marks unmarked files matching REGEXP, displaying MSG.
|
|
|
703 REGEXP is matched against the complete pathname.
|
|
|
704 Does not re-mark files which already have a mark.
|
|
|
705 With prefix argument, unflag all those files.
|
|
|
706 Second optional argument LOCALP is as in `dired-get-filename'."
|
|
|
707 (interactive "P")
|
|
|
708 (let ((dired-marker-char (if unflag-p ?\ dired-marker-char)))
|
|
|
709 (dired-mark-if
|
|
|
710 (and
|
|
|
711 ;; not already marked
|
|
|
712 (looking-at " ")
|
|
|
713 ;; uninteresting
|
|
|
714 (let ((fn (dired-get-filename localp t)))
|
|
|
715 (and fn (string-match regexp fn))))
|
|
|
716 msg)))
|
|
|
717
|
|
|
718 (defun dired-omit-new-add-entry (filename &optional marker-char)
|
|
|
719 ;; This redefines dired.el's dired-add-entry to avoid calling ls for
|
|
|
720 ;; files that are going to be omitted anyway.
|
|
|
721 (if dired-omit-files-p
|
|
|
722 ;; perhaps return t without calling ls
|
|
|
723 (let ((omit-re (dired-omit-regexp)))
|
|
|
724 (if (or (string= omit-re "")
|
|
|
725 (not
|
|
|
726 (string-match omit-re
|
|
|
727 (cond
|
|
|
728 ((eq 'no-dir dired-omit-localp)
|
|
|
729 filename)
|
|
|
730 ((eq t dired-omit-localp)
|
|
|
731 (dired-make-relative filename))
|
|
|
732 (t
|
|
|
733 (dired-make-absolute filename directory))))))
|
|
|
734 ;; if it didn't match, go ahead and add the entry
|
|
|
735 (dired-omit-old-add-entry filename marker-char)
|
|
|
736 ;; dired-add-entry returns t for success, perhaps we should
|
|
|
737 ;; return file-exists-p
|
|
|
738 t))
|
|
|
739 ;; omitting is not turned on at all
|
|
|
740 (dired-omit-old-add-entry filename marker-char)))
|
|
|
741
|
|
|
742 ;; Save old defun if not already done:
|
|
|
743 (or (fboundp 'dired-omit-old-add-entry)
|
|
|
744 (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry)))
|
|
|
745 ;; Redefine dired.el
|
|
|
746 (fset 'dired-add-entry 'dired-omit-new-add-entry)
|
|
|
747
|
|
|
748
|
|
|
749 ;;
|
|
|
750 (defun dired-mark-sexp (predicate &optional unflag-p)
|
|
|
751 "Mark files for which PREDICATE returns non-nil.
|
|
|
752 With a prefix arg, unflag those files instead.
|
|
|
753
|
|
|
754 PREDICATE is a lisp expression that can refer to the following symbols:
|
|
|
755
|
|
|
756 inode [integer] the inode of the file (only for ls -i output)
|
|
|
757 s [integer] the size of the file for ls -s output
|
|
|
758 (ususally in blocks or, with -k, in KByte)
|
|
|
759 mode [string] file permission bits, e.g. \"-rw-r--r--\"
|
|
|
760 nlink [integer] number of links to file
|
|
|
761 uid [string] owner
|
|
|
762 gid [string] group (If the gid is not displayed by ls,
|
|
|
763 this will still be set (to the same as uid))
|
|
|
764 size [integer] file size in bytes
|
|
|
765 time [string] the time that ls displays, e.g. \"Feb 12 14:17\"
|
|
|
766 name [string] the name of the file
|
|
|
767 sym [string] if file is a symbolic link, the linked-to name, else \"\"
|
|
|
768
|
|
|
769 For example, use
|
|
|
770
|
|
|
771 (equal 0 size)
|
|
|
772
|
|
|
773 to mark all zero length files."
|
|
|
774 ;; Using sym="" instead of nil avoids the trap of
|
|
|
775 ;; (string-match "foo" sym) into which a user would soon fall.
|
|
|
776 ;; Give `equal' instead of `=' in the example, as this works on
|
|
|
777 ;; integers and strings.
|
|
|
778 (interactive "xMark if (lisp expr): \nP")
|
|
|
779 (message "%s" predicate)
|
|
|
780 (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
|
|
|
781 inode s mode nlink uid gid size time name sym)
|
|
|
782 (dired-mark-if
|
|
|
783 (save-excursion (and (dired-parse-ls)
|
|
|
784 (eval predicate)))
|
|
|
785 (format "'%s file" predicate))
|
|
|
786 ;; With Jamie's compiler we could do the following instead:
|
|
|
787 ; (eval (byte-compile-sexp
|
|
|
788 ; (macroexpand
|
|
|
789 ; (` (dired-mark-if
|
|
|
790 ; (save-excursion (and (dired-parse-ls)
|
|
|
791 ; (, predicate)))
|
|
|
792 ; (format "'%s file" (quote (, predicate))))))))
|
|
|
793 ;; This isn't measurably faster, though, at least for simple predicates.
|
|
|
794 ;; Caching compiled predicates might be interesting if you use
|
|
|
795 ;; this command a lot or with complicated predicates.
|
|
|
796 ;; Alternatively compiling PREDICATE by hand should not be too
|
|
|
797 ;; hard - e.g., if it uses just one variable, not all of the ls
|
|
|
798 ;; line needs to be parsed.
|
|
|
799 ))
|
|
|
800
|
|
|
801 (if (fboundp 'gmhist-make-magic)
|
|
|
802 (gmhist-make-magic 'dired-mark-sexp 'eval-expression-history))
|
|
|
803
|
|
|
804 (defun dired-parse-ls ()
|
|
|
805 ;; Sets vars
|
|
|
806 ;; inode s mode nlink uid gid size time name sym
|
|
|
807 ;; (probably let-bound in caller) according to current file line.
|
|
|
808 ;; Returns t for succes, nil if this is no file line.
|
|
|
809 ;; Upon success, all variables are set, either to nil or the
|
|
|
810 ;; appropriate value, so they need not be initialized.
|
|
|
811 ;; Moves point within the current line.
|
|
|
812 (if (dired-move-to-filename)
|
|
|
813 (let (pos
|
|
|
814 (mode-len 10) ; length of mode string
|
|
|
815 ;; like in dired.el, but with subexpressions \1=inode, \2=s:
|
|
|
816 (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?"))
|
|
|
817 (beginning-of-line)
|
|
|
818 (forward-char 2)
|
|
|
819 (if (looking-at dired-re-inode-size)
|
|
|
820 (progn
|
|
|
821 (goto-char (match-end 0))
|
|
|
822 (setq inode (string-to-int (buffer-substring (match-beginning 1)
|
|
|
823 (match-end 1)))
|
|
|
824 s (string-to-int (buffer-substring (match-beginning 2)
|
|
|
825 (match-end 2)))))
|
|
|
826 (setq inode nil
|
|
|
827 s nil))
|
|
|
828 (setq mode (buffer-substring (point) (+ mode-len (point))))
|
|
|
829 (forward-char mode-len)
|
|
|
830 (setq nlink (read (current-buffer)))
|
|
|
831 (setq uid (buffer-substring (point) (progn (forward-word 1) (point))))
|
|
|
832 (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)")
|
|
|
833 (goto-char (match-beginning 1))
|
|
|
834 (forward-char -1)
|
|
|
835 (setq size (string-to-int (buffer-substring (save-excursion
|
|
|
836 (backward-word 1)
|
|
|
837 (setq pos (point)))
|
|
|
838 (point))))
|
|
|
839 (goto-char pos)
|
|
|
840 (backward-word 1)
|
|
|
841 ;; if no gid is displayed, gid will be set to uid
|
|
|
842 ;; but user will then not reference it anyway in PREDICATE.
|
|
|
843 (setq gid (buffer-substring (save-excursion (forward-word 1) (point))
|
|
|
844 (point))
|
|
|
845 time (buffer-substring (match-beginning 1)
|
|
|
846 (1- (dired-move-to-filename)))
|
|
|
847 name (buffer-substring (point)
|
|
|
848 (or (dired-move-to-end-of-filename t)
|
|
|
849 (point)))
|
|
|
850 sym (progn
|
|
|
851 (if (looking-at " -> ")
|
|
|
852 (buffer-substring (progn (forward-char 4) (point))
|
|
|
853 (progn (end-of-line) (point)))
|
|
|
854 "")))
|
|
|
855 t)
|
|
|
856 nil))
|
|
|
857
|
|
|
858
|
|
|
859 ;; tester
|
|
|
860 ;;(defun dired-parse-ls-show ()
|
|
|
861 ;; (interactive)
|
|
|
862 ;; (let (inode s mode size uid gid nlink time name sym)
|
|
|
863 ;; (if (dired-parse-ls)
|
|
|
864 ;; (message "%s" (list inode s mode nlink uid gid size time name sym))
|
|
|
865 ;; (message "Not on a file line."))))
|
|
|
866
|
|
|
867
|
|
|
868 ;; Mark files whose names appear in another buffer.
|
|
|
869
|
|
|
870 (defun dired-mark-these-files (file-list from)
|
|
|
871 ;; Mark the files in FILE-LIST. Relative filenames are taken to be
|
|
|
872 ;; in the current dired directory.
|
|
|
873 ;; FROM is a string (used for logging) describing where FILE-LIST
|
|
|
874 ;; came from.
|
|
|
875 ;; Logs files that were not found and displays a success or failure
|
|
|
876 ;; message.
|
|
|
877 (message "Marking files %s..." from)
|
|
|
878 (let ((total (length file-list))
|
|
|
879 (cur-dir (dired-current-directory))
|
|
|
880 file failures)
|
|
|
881 (while file-list
|
|
|
882 (setq file (dired-make-absolute (car file-list) cur-dir)
|
|
|
883 file-list (cdr file-list))
|
|
|
884 ;;(message "Marking file `%s'" file)
|
|
|
885 (save-excursion
|
|
|
886 (if (dired-goto-file file)
|
|
|
887 (dired-mark-file 1)
|
|
|
888 (setq failures (cons (dired-make-relative file) failures))
|
|
|
889 (dired-log "Cannot mark this file (not found): %s\n" file))))
|
|
|
890 (if failures
|
|
|
891 (dired-log-summary (message "Failed to mark %d of %d files %s %s"
|
|
|
892 (length failures) total from failures))
|
|
|
893 (message "Marked %d file%s %s." total (dired-plural-s total) from))))
|
|
|
894
|
|
|
895 (defun dired-mark-files-from-other-dired-buffer (buf)
|
|
|
896 "Mark files that are marked in the other Dired buffer.
|
|
|
897 I.e, mark those files in this Dired buffer that have the same
|
|
|
898 non-directory part as the marked files in the Dired buffer in the other window."
|
|
|
899 (interactive (list (window-buffer (next-window))))
|
|
|
900 (if (eq (get-buffer buf) (current-buffer))
|
|
|
901 (error "Other dired buffer is the same"))
|
|
|
902 (or (stringp buf) (setq buf (buffer-name buf)))
|
|
|
903 (let ((other-files (save-excursion
|
|
|
904 (set-buffer buf)
|
|
|
905 (or (eq major-mode 'dired-mode)
|
|
|
906 (error "%s is not a dired buffer" buf))
|
|
|
907 (dired-mark-get-files 'no-dir))))
|
|
|
908 (dired-mark-these-files other-files (concat "from buffer " buf))))
|
|
|
909
|
|
|
910 (defun dired-mark-files-compilation-buffer (&optional regexp buf)
|
|
|
911 "Mark the files mentioned in the `*compilation*' buffer.
|
|
|
912 With an arg, you may specify the other buffer and your own regexp
|
|
|
913 instead of `compilation-error-regexp'.
|
|
|
914 Use `^.+$' (the default with a prefix arg) to match complete lines or
|
|
|
915 an empty string for `compilation-error-regexp'.
|
|
|
916 In conjunction with narrowing the other buffer you can mark an
|
|
|
917 arbitrary list of files, one per line, with this command."
|
|
|
918 (interactive
|
|
|
919 (if current-prefix-arg
|
|
|
920 (list
|
|
|
921 (read-string "Use compilation regexp: " "^.+$")
|
|
|
922 (read-buffer "Use buffer: "
|
|
|
923 (let ((next-buffer (window-buffer (next-window))))
|
|
|
924 (if (eq next-buffer (current-buffer))
|
|
|
925 (other-buffer)
|
|
|
926 next-buffer))))))
|
|
|
927 (let (other-files user-regexp-p)
|
|
|
928 (if (zerop (length regexp)) ; nil or ""
|
|
|
929 (setq regexp compilation-error-regexp)
|
|
|
930 (setq user-regexp-p t))
|
|
|
931 (or buf (setq buf "*compilation*"))
|
|
|
932 (or (stringp buf) (setq buf (buffer-name buf)))
|
|
|
933 (save-excursion
|
|
|
934 (set-buffer (or (get-buffer buf)
|
|
|
935 (error "No %s buffer!" buf)))
|
|
|
936 (goto-char (point-min))
|
|
|
937 (let (file new-file)
|
|
|
938 (while (re-search-forward regexp nil t)
|
|
|
939 (setq new-file
|
|
|
940 (buffer-substring
|
|
|
941 ;; If user specified a regexp with subexpr 1, and it
|
|
|
942 ;; matched, take that one for the file name, else
|
|
|
943 ;; take whole match.
|
|
|
944 ;; Else take the match from the compile regexp
|
|
|
945 (if user-regexp-p
|
|
|
946 (or (match-beginning 1)
|
|
|
947 (match-beginning 0))
|
|
|
948 (match-beginning 1))
|
|
|
949 (if user-regexp-p
|
|
|
950 (or (match-end 1)
|
|
|
951 (match-end 0))
|
|
|
952 (match-beginning 2))))
|
|
|
953 (or (equal file new-file)
|
|
|
954 ;; Avoid marking files twice as this is slow. Multiple
|
|
|
955 ;; lines for the same file are common when compiling.
|
|
|
956 (setq other-files (cons new-file other-files)
|
|
|
957 file new-file)))))
|
|
|
958 (dired-mark-these-files other-files (concat "from buffer " buf))))
|
|
|
959
|
|
|
960
|
|
|
961 ;; make-symbolic-link always expand-file-name's its args, so relative
|
|
|
962 ;; symlinks (e.g. "foo" -> "../bar/foo") are impossible to create.
|
|
|
963 ;; Following code uses ln -s for a workaround.
|
|
|
964
|
|
|
965 (defvar dired-keep-marker-relsymlink ?S
|
|
|
966 "See variable `dired-keep-marker-move'.")
|
|
|
967
|
|
|
968 (defun dired-make-symbolic-link (name1 name2 &optional ok-if-already-exists)
|
|
|
969 ;; Args NAME1 NAME2 &optional OK-IF-ALREADY-EXISTS.
|
|
|
970 ;; Create file NAME2, a symbolic link pointing to NAME1 (which may
|
|
|
971 ;; be any string whatsoever and is passed untouched to ln -s).
|
|
|
972 ;; OK-IF-ALREADY-EXISTS means that NAME2 will be overwritten if it
|
|
|
973 ;; already exists. If it is an integer, user will be asked about this.
|
|
|
974 ;; On error, signals a file-error.
|
|
|
975 (interactive "FSymlink to (string): \nFMake symbolic link to `%s': \np")
|
|
|
976 (setq name2 (expand-file-name name2))
|
|
|
977 (let* ((file-symlink-p (file-symlink-p name2))
|
|
|
978 (file-exists-p (file-exists-p name2)) ; dereferences symlinks
|
|
|
979 (file-or-symlink-exists (or file-symlink-p file-exists-p)))
|
|
|
980 (if (and file-symlink-p (not file-exists-p))
|
|
|
981 ;; We do something dirty here as dired.el never checks
|
|
|
982 ;; file-symlink-p in addition to file-exists-p.
|
|
|
983 ;; This way me make sure we never silently overwrite even
|
|
|
984 ;; symlinks to non-existing files (what an achievement! ;-)
|
|
|
985 (setq ok-if-already-exists 1))
|
|
|
986 (if (or (null ok-if-already-exists)
|
|
|
987 (integerp ok-if-already-exists))
|
|
|
988 (if (and file-or-symlink-exists
|
|
|
989 (not (and (integerp ok-if-already-exists)
|
|
|
990 (yes-or-no-p
|
|
|
991 (format
|
|
|
992 "File %s already exists; symlink anyway? "
|
|
|
993 name2)))))
|
|
|
994 (signal 'file-error (cons "File already exists" name2))))
|
|
|
995 ;; Bombs if NAME1 starts with "-", but not all ln programs may
|
|
|
996 ;; understand "--" to mean end of options...sigh
|
|
|
997 (let (err)
|
|
|
998 (if file-or-symlink-exists (delete-file name2))
|
|
|
999 (setq err (dired-check-process "SymLink" "ln" "-s" name1 name2))
|
|
|
1000 (if err
|
|
|
1001 (signal 'file-error (cons "ln" err))))))
|
|
|
1002
|
|
|
1003 (defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
|
|
|
1004 "Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS
|
|
|
1005 Make a symbolic link (pointing to FILE1) in FILE2.
|
|
|
1006 The link is relative (if possible), for example
|
|
|
1007
|
|
|
1008 \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
|
|
|
1009
|
|
|
1010 results in
|
|
|
1011
|
|
|
1012 \"../../tex/bin/foo\" \"/vol/local/bin/foo\"
|
|
|
1013 "
|
|
|
1014 (interactive "FRelSymLink: \nFRelSymLink %s: \np")
|
|
|
1015 (let (name1 name2 len1 len2 (index 0) sub)
|
|
|
1016 (setq file1 (expand-file-name file1)
|
|
|
1017 file2 (expand-file-name file2)
|
|
|
1018 len1 (length file1)
|
|
|
1019 len2 (length file2))
|
|
|
1020 ;; Find common initial pathname components:
|
|
|
1021 (let (next)
|
|
|
1022 (while (and (setq next (string-match "/" file1 index))
|
|
|
1023 (setq next (1+ next))
|
|
|
1024 (< next (min len1 len2))
|
|
|
1025 ;; For the comparison, both substrings must end in
|
|
|
1026 ;; `/', so NEXT is *one plus* the result of the
|
|
|
1027 ;; string-match.
|
|
|
1028 ;; E.g., consider the case of linking "/tmp/a/abc"
|
|
|
1029 ;; to "/tmp/abc" erronously giving "/tmp/a" instead
|
|
|
1030 ;; of "/tmp/" as common initial component
|
|
|
1031 (string-equal (substring file1 0 next)
|
|
|
1032 (substring file2 0 next)))
|
|
|
1033 (setq index next))
|
|
|
1034 (setq name2 file2
|
|
|
1035 sub (substring file1 0 index)
|
|
|
1036 name1 (substring file1 index)))
|
|
|
1037 (if (string-equal sub "/")
|
|
|
1038 ;; No common initial pathname found
|
|
|
1039 (setq name1 file1)
|
|
|
1040 ;; Else they have a common parent directory
|
|
|
1041 (let ((tem (substring file2 index))
|
|
|
1042 (start 0)
|
|
|
1043 (count 0))
|
|
|
1044 ;; Count number of slashes we must compensate for ...
|
|
|
1045 (while (setq start (string-match "/" tem start))
|
|
|
1046 (setq count (1+ count)
|
|
|
1047 start (1+ start)))
|
|
|
1048 ;; ... and prepend a "../" for each slash found:
|
|
|
1049 (while (> count 0)
|
|
|
1050 (setq count (1- count)
|
|
|
1051 name1 (concat "../" name1)))))
|
|
|
1052 (dired-make-symbolic-link
|
|
|
1053 (directory-file-name name1) ; must not link to foo/
|
|
|
1054 ; (trailing slash!)
|
|
|
1055 name2 ok-if-already-exists)))
|
|
|
1056
|
|
|
1057 (defun dired-do-relsymlink (&optional arg)
|
|
|
1058 "Symlink all marked (or next ARG) files into a directory,
|
|
|
1059 or make a symbolic link to the current file.
|
|
|
1060 This creates relative symbolic links like
|
|
|
1061
|
|
|
1062 foo -> ../bar/foo
|
|
|
1063
|
|
|
1064 not absolute ones like
|
|
|
1065
|
|
|
1066 foo -> /ugly/path/that/may/change/any/day/bar/foo"
|
|
|
1067 (interactive "P")
|
|
|
1068 (dired-do-create-files 'relsymlink (function dired-make-relative-symlink)
|
|
|
1069 "RelSymLink" arg dired-keep-marker-relsymlink))
|
|
|
1070
|
|
|
1071 ;; XEmacs: added extra arg per tbarker@sun059.cpdsc.com (Ted Barker)
|
|
|
1072 (defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-path)
|
|
|
1073 "RelSymlink all marked files containing REGEXP to NEWNAME.
|
|
|
1074 See functions `dired-rename-regexp' and `dired-do-relsymlink'
|
|
|
1075 for more info. With optional prefix ARG, will operate on ARG files following
|
|
|
1076 point if no files are marked."
|
|
|
1077 (interactive (dired-mark-read-regexp "RelSymLink"))
|
|
|
1078 (dired-do-create-files-regexp
|
|
|
1079 (function dired-make-relative-symlink)
|
|
|
1080 "RelSymLink" arg regexp newname whole-path dired-keep-marker-relsymlink))
|
|
|
1081
|
|
|
1082 ;; Virtual dired mode to browse ls -lR listings
|
|
|
1083 ;; sk@sun5 7-Mar-1991 16:00
|
|
|
1084
|
|
|
1085 (fset 'virtual-dired 'dired-virtual)
|
|
|
1086 (defun dired-virtual (dirname &optional switches)
|
|
|
1087 "Put this buffer into Virtual Dired mode.
|
|
|
1088
|
|
|
1089 In Virtual Dired mode, all commands that do not actually consult the
|
|
|
1090 filesystem will work.
|
|
|
1091
|
|
|
1092 This is useful if you want to peruse and move around in an ls -lR
|
|
|
1093 output file, for example one you got from an ftp server. With
|
|
|
1094 ange-ftp, you can even dired a directory containing an ls-lR file,
|
|
|
1095 visit that file and turn on virtual dired mode. But don't try to save
|
|
|
1096 this file, as dired-virtual indents the listing and thus changes the
|
|
|
1097 buffer.
|
|
|
1098
|
|
|
1099 If you have save a Dired buffer in a file you can use \\[dired-virtual] to
|
|
|
1100 resume it in a later session.
|
|
|
1101
|
|
|
1102 Type \\<dired-mode-map>\\[revert-buffer] in the
|
|
|
1103 Virtual Dired buffer and answer `y' to convert the virtual to a real
|
|
|
1104 dired buffer again. You don't have to do this, though: you can relist
|
|
|
1105 single subdirs using \\[dired-do-redisplay].
|
|
|
1106 "
|
|
|
1107
|
|
|
1108 ;; DIRNAME is the top level directory of the buffer. It will become
|
|
|
1109 ;; its `default-directory'. If nil, the old value of
|
|
|
1110 ;; default-directory is used.
|
|
|
1111
|
|
|
1112 ;; Optional SWITCHES are the ls switches to use.
|
|
|
1113
|
|
|
1114 ;; Shell wildcards will be used if there already is a `wildcard'
|
|
|
1115 ;; line in the buffer (thus it is a saved Dired buffer), but there
|
|
|
1116 ;; is no other way to get wildcards. Insert a `wildcard' line by
|
|
|
1117 ;; hand if you want them.
|
|
|
1118
|
|
|
1119 (interactive
|
|
|
1120 (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir))))
|
|
|
1121 (goto-char (point-min))
|
|
|
1122 (or (looking-at " ")
|
|
|
1123 ;; if not already indented, do it now:
|
|
|
1124 (indent-region (point-min) (point-max) 2))
|
|
|
1125 (or dirname (setq dirname default-directory))
|
|
|
1126 (setq dirname (expand-file-name (file-name-as-directory dirname)))
|
|
|
1127 (setq default-directory dirname) ; contains no wildcards
|
|
|
1128 (let ((wildcard (save-excursion
|
|
|
1129 (goto-char (point-min))
|
|
|
1130 (forward-line 1)
|
|
|
1131 (and (looking-at "^ wildcard ")
|
|
|
1132 (buffer-substring (match-end 0)
|
|
|
1133 (progn (end-of-line) (point)))))))
|
|
|
1134 (if wildcard
|
|
|
1135 (setq dirname (expand-file-name wildcard default-directory))))
|
|
|
1136 ;; If raw ls listing (not a saved old dired buffer), give it a
|
|
|
1137 ;; decent subdir headerline:
|
|
|
1138 (goto-char (point-min))
|
|
|
1139 (or (looking-at dired-subdir-regexp)
|
|
|
1140 (dired-insert-headerline default-directory))
|
|
|
1141 (dired-mode dirname (or switches dired-listing-switches))
|
|
|
1142 (setq mode-name "Virtual Dired"
|
|
|
1143 revert-buffer-function 'dired-virtual-revert)
|
|
|
1144 (set (make-local-variable 'dired-subdir-alist) nil)
|
|
|
1145 (dired-build-subdir-alist)
|
|
|
1146 (goto-char (point-min))
|
|
|
1147 (dired-initial-position dirname))
|
|
|
1148
|
|
|
1149 (defun dired-virtual-guess-dir ()
|
|
|
1150
|
|
|
1151 ;; Guess and return appropriate working directory of this buffer,
|
|
|
1152 ;; assumed to be in Dired or ls -lR format.
|
|
|
1153 ;; The guess is based upon buffer contents.
|
|
|
1154 ;; If nothing could be guessed, returns nil.
|
|
|
1155
|
|
|
1156 (let ((regexp "^\\( \\)?\\([^ \n\r]*\\)\\(:\\)[\n\r]")
|
|
|
1157 (subexpr 2))
|
|
|
1158 (goto-char (point-min))
|
|
|
1159 (cond ((looking-at regexp)
|
|
|
1160 ;; If a saved dired buffer, look to which dir and
|
|
|
1161 ;; perhaps wildcard it belongs:
|
|
|
1162 (let ((dir (buffer-substring (match-beginning subexpr)
|
|
|
1163 (match-end subexpr))))
|
|
|
1164 (file-name-as-directory dir)))
|
|
|
1165 ;; Else no match for headerline found. It's a raw ls listing.
|
|
|
1166 ;; In raw ls listings the directory does not have a headerline
|
|
|
1167 ;; try parent of first subdir, if any
|
|
|
1168 ((re-search-forward regexp nil t)
|
|
|
1169 (file-name-directory
|
|
|
1170 (directory-file-name
|
|
|
1171 (file-name-as-directory
|
|
|
1172 (buffer-substring (match-beginning subexpr)
|
|
|
1173 (match-end subexpr))))))
|
|
|
1174 (t ; if all else fails
|
|
|
1175 nil))))
|
|
|
1176
|
|
|
1177
|
|
|
1178 (defun dired-virtual-revert (&optional arg noconfirm)
|
|
|
1179 (if (not
|
|
|
1180 (y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? "))
|
|
|
1181 (error "Cannot revert a Virtual Dired buffer.")
|
|
|
1182 (setq mode-name "Dired"
|
|
|
1183 revert-buffer-function 'dired-revert)
|
|
|
1184 (revert-buffer)))
|
|
|
1185
|
|
|
1186 ;; A zero-arg version of dired-virtual.
|
|
|
1187 ;; You need my modified version of set-auto-mode for the
|
|
|
1188 ;; `buffer-contents-mode-alist'.
|
|
|
1189 ;; Or you use infer-mode.el and infer-mode-alist, same syntax.
|
|
|
1190 (defun dired-virtual-mode ()
|
|
|
1191 "Put current buffer into virtual dired mode (see `dired-virtual').
|
|
|
1192 Useful on `buffer-contents-mode-alist' (which see) with the regexp
|
|
|
1193
|
|
|
1194 \"^ \\(/[^ /]+\\)/?+:$\"
|
|
|
1195
|
|
|
1196 to put saved dired buffers automatically into virtual dired mode.
|
|
|
1197
|
|
|
1198 Also useful for `auto-mode-alist' (which see) like this:
|
|
|
1199
|
|
|
1200 \(setq auto-mode-alist (cons '(\"[^/]\\.dired$\" . dired-virtual-mode)
|
|
|
1201 auto-mode-alist)\)
|
|
|
1202 "
|
|
|
1203 (interactive)
|
|
|
1204 (dired-virtual (dired-virtual-guess-dir)))
|
|
|
1205
|
|
|
1206
|
|
|
1207 (defvar dired-find-subdir nil ; t is pretty near to DWIM...
|
|
|
1208 "*If non-nil, Dired does not make a new buffer for a directory if it
|
|
|
1209 can be found (perhaps as subdir) in some existing Dired buffer.
|
|
|
1210
|
|
|
1211 If there are several Dired buffers for a directory, the most recently
|
|
|
1212 used is chosen.
|
|
|
1213
|
|
|
1214 Dired avoids switching to the current buffer, so that if you have
|
|
|
1215 a normal and a wildcard buffer for the same directory, C-x d RET will
|
|
|
1216 toggle between those two.")
|
|
|
1217
|
|
|
1218 (or (fboundp 'dired-old-find-buffer-nocreate)
|
|
|
1219 (fset 'dired-old-find-buffer-nocreate
|
|
|
1220 (symbol-function 'dired-find-buffer-nocreate)))
|
|
|
1221
|
|
|
1222 (defun dired-find-buffer-nocreate (dirname) ; redefine dired.el
|
|
|
1223 (if dired-find-subdir
|
|
|
1224 (let* ((cur-buf (current-buffer))
|
|
|
1225 (buffers (nreverse (dired-buffers-for-dir-exact dirname)))
|
|
|
1226 (cur-buf-matches (and (memq cur-buf buffers)
|
|
|
1227 ;; wildcards must match, too:
|
|
|
1228 (equal dired-directory dirname))))
|
|
|
1229 ;; We don't want to switch to the same buffer---
|
|
|
1230 (setq buffers (delq cur-buf buffers));;need setq with delq
|
|
|
1231 (or (car (sort buffers (function dired-x-buffer-more-recently-used-p)))
|
|
|
1232 ;; ---unless it's the only possibility:
|
|
|
1233 (and cur-buf-matches cur-buf)))
|
|
|
1234 (dired-old-find-buffer-nocreate dirname)))
|
|
|
1235
|
|
|
1236 ;; this should be a builtin
|
|
|
1237 (defun dired-x-buffer-more-recently-used-p (buffer1 buffer2)
|
|
|
1238 "Return t if BUFFER1 is more recently used than BUFFER2."
|
|
|
1239 (if (equal buffer1 buffer2)
|
|
|
1240 nil
|
|
|
1241 (let ((more-recent nil)
|
|
|
1242 (list (buffer-list)))
|
|
|
1243 (while (and list
|
|
|
1244 (not (setq more-recent (equal buffer1 (car list))))
|
|
|
1245 (not (equal buffer2 (car list))))
|
|
|
1246 (setq list (cdr list)))
|
|
|
1247 more-recent)))
|
|
|
1248
|
|
|
1249 (defun dired-buffers-for-dir-exact (dir)
|
|
|
1250 ;; Return a list of buffers that dired DIR (a directory or wildcard)
|
|
|
1251 ;; at top level, or as subdirectory.
|
|
|
1252 ;; Top level matches must match the wildcard part too, if any.
|
|
|
1253 ;; The list is in reverse order of buffer creation, most recent last.
|
|
|
1254 ;; As a side effect, killed dired buffers for DIR are removed from
|
|
|
1255 ;; dired-buffers.
|
|
|
1256 (let ((alist dired-buffers) result elt)
|
|
|
1257 (while alist
|
|
|
1258 (setq elt (car alist)
|
|
|
1259 alist (cdr alist))
|
|
|
1260 (let ((buf (cdr elt)))
|
|
|
1261 (if (buffer-name buf)
|
|
|
1262 ;; Top level must match exactly against dired-directory in
|
|
|
1263 ;; case one of them is a wildcard.
|
|
|
1264 (if (or (equal dir (save-excursion (set-buffer buf)
|
|
|
1265 dired-directory))
|
|
|
1266 (assoc dir (save-excursion (set-buffer buf)
|
|
|
1267 dired-subdir-alist)))
|
|
|
1268 (setq result (cons buf result)))
|
|
|
1269 ;; else buffer is killed - clean up:
|
|
|
1270 (setq dired-buffers (delq elt dired-buffers)))))
|
|
|
1271 result))
|
|
|
1272
|
|
|
1273 (defun dired-buffers-for-top-dir (dir)
|
|
|
1274 ;; Return a list of buffers that dired DIR (a directory, not a wildcard)
|
|
|
1275 ;; at top level, with or without wildcards.
|
|
|
1276 ;; As a side effect, killed dired buffers for DIR are removed from
|
|
|
1277 ;; dired-buffers.
|
|
|
1278 (setq dir (file-name-as-directory dir))
|
|
|
1279 (let ((alist dired-buffers) result elt)
|
|
|
1280 (while alist
|
|
|
1281 (setq elt (car alist)
|
|
|
1282 alist (cdr alist))
|
|
|
1283 (let ((buf (cdr elt)))
|
|
|
1284 (if (buffer-name buf)
|
|
|
1285 (if (equal dir (save-excursion (set-buffer buf) default-directory))
|
|
|
1286 (setq result (cons buf result)))
|
|
|
1287 ;; else buffer is killed - clean up:
|
|
|
1288 (setq dired-buffers (delq elt dired-buffers)))))
|
|
|
1289 result))
|
|
|
1290
|
|
|
1291 (defun dired-initial-position (dirname) ; redefine dired.el
|
|
|
1292 (end-of-line)
|
|
|
1293 (if dired-find-subdir (dired-goto-subdir dirname)) ; new
|
|
|
1294 (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
|
|
|
1295
|
|
|
1296 ;;; Let `C-x f' and `C-x 4 f' know about Tree Dired's multiple directories.
|
|
|
1297 ;;; As a bonus, you get filename-at-point as default with a prefix arg.
|
|
|
1298
|
|
|
1299 ;; It's easier to add to this alist than redefine function
|
|
|
1300 ;; default-directory while keeping the old information.
|
|
|
1301 (defconst default-directory-alist
|
|
|
1302 '((dired-mode . (if (fboundp 'dired-current-directory)
|
|
|
1303 (dired-current-directory)
|
|
|
1304 default-directory)))
|
|
|
1305 "Alist of major modes and their opinion on default-directory, as a
|
|
|
1306 lisp expression to evaluate. A resulting value of nil is ignored in
|
|
|
1307 favor of default-directory.")
|
|
|
1308
|
|
|
1309 (defun default-directory ()
|
|
|
1310 "Usage like variable `default-directory', but knows about the special
|
|
|
1311 cases in variable `default-directory-alist' (which see)."
|
|
|
1312 (or (eval (cdr (assq major-mode default-directory-alist)))
|
|
|
1313 default-directory))
|
|
|
1314
|
|
|
1315 (defun find-file-read-filename-at-point (prompt)
|
|
|
1316 (if (fboundp 'gmhist-read-file-name)
|
|
|
1317 (if current-prefix-arg
|
|
|
1318 (let ((fn (filename-at-point)))
|
|
|
1319 (gmhist-read-file-name
|
|
|
1320 prompt (default-directory) fn nil
|
|
|
1321 ;; the INITIAL arg is only accepted in Emacs 19 or with gmhist:
|
|
|
1322 fn))
|
|
|
1323 (gmhist-read-file-name prompt (default-directory)))
|
|
|
1324 ;; Else gmhist is not available, thus no initial input possible.
|
|
|
1325 ;; Could use filename-at-point as default and mung prompt...ugh.
|
|
|
1326 ;; Nah, get gmhist, folks!
|
|
|
1327 (read-file-name prompt (default-directory))))
|
|
|
1328
|
|
|
1329 (defun filename-at-point ()
|
|
|
1330 "Get the filename closest to point, but don't change your position.
|
|
|
1331 Has a preference for looking backward when not directly on a symbol."
|
|
|
1332 ;; Not at all perfect - point must be right in the name.
|
|
|
1333 (let ((filename-chars ".a-zA-Z0-9---_/:$") start end filename
|
|
|
1334 (bol (save-excursion (beginning-of-line) (point)))
|
|
|
1335 (eol (save-excursion (end-of-line) (point))))
|
|
|
1336 (save-excursion
|
|
|
1337 ;; first see if you're just past a filename
|
|
|
1338 (if (not (eobp))
|
|
|
1339 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
|
|
|
1340 (progn
|
|
|
1341 (skip-chars-backward " \n\t\r({[]})")
|
|
|
1342 (if (not (bobp))
|
|
|
1343 (backward-char 1)))))
|
|
|
1344 (if (string-match (concat "[" filename-chars "]")
|
|
|
1345 (char-to-string (following-char)))
|
|
|
1346 (progn
|
|
|
1347 (skip-chars-backward filename-chars)
|
|
|
1348 (setq start (point))
|
|
|
1349 (if (string-match "[/~]" (char-to-string (preceding-char)))
|
|
|
1350 (setq start (1- start)))
|
|
|
1351 (skip-chars-forward filename-chars))
|
|
|
1352 (error "No file found around point!"))
|
|
|
1353 (expand-file-name (buffer-substring start (point))))))
|
|
|
1354
|
|
|
1355 (defun find-this-file (fn)
|
|
|
1356 "Edit file FILENAME.
|
|
|
1357 Switch to a buffer visiting file FILENAME, creating one if none already exists.
|
|
|
1358
|
|
|
1359 Interactively, with a prefix arg, calls `filename-at-point'.
|
|
|
1360 Useful to edit the file mentioned in the buffer you are editing, or to
|
|
|
1361 test if that file exists: use minibuffer completion after snatching the
|
|
|
1362 name or part of it."
|
|
|
1363 (interactive (list (find-file-read-filename-at-point "Find file: ")))
|
|
|
1364 (find-file (expand-file-name fn)))
|
|
|
1365
|
|
|
1366 (defun find-this-file-other-window (fn)
|
|
|
1367 "Edit file FILENAME in other window.
|
|
|
1368 Switch to a buffer visiting file FILENAME, creating one if none already exists.
|
|
|
1369
|
|
|
1370 Interactively, with a prefix arg, call `filename-at-point'.
|
|
|
1371 Useful to edit the file mentioned in the buffer you are editing, or to
|
|
|
1372 test if that file exists: use minibuffer completion after snatching the
|
|
|
1373 name or part of it."
|
|
|
1374 (interactive (list (find-file-read-filename-at-point "Find file: ")))
|
|
|
1375 (find-file-other-window (expand-file-name fn)))
|
|
|
1376
|
|
|
1377 (defun dired-smart-shell-command (cmd &optional insert)
|
|
|
1378 "Like function `shell-command', but in the current Tree Dired directory."
|
|
|
1379 (interactive "sShell command: \nP")
|
|
|
1380 (let ((default-directory (default-directory)))
|
|
|
1381 (shell-command cmd insert)))
|
|
|
1382
|
|
|
1383 (if (fboundp 'gmhist-make-magic)
|
|
|
1384 (gmhist-make-magic 'dired-smart-shell-command 'shell-history))
|
|
|
1385
|
|
|
1386 (defun dired-smart-background-shell-command (cmd)
|
|
|
1387 "Run a shell command in the background.
|
|
|
1388 Like function `background' but in the current Tree Dired directory."
|
|
|
1389 (interactive "s%% ")
|
|
|
1390 (shell-command (concat "cd " (default-directory) "; " cmd " &")))
|
|
|
1391
|
|
|
1392 (if (fboundp 'gmhist-make-magic)
|
|
|
1393 (gmhist-make-magic 'dired-smart-background-shell-command 'shell-history))
|
|
|
1394
|
|
|
1395
|
|
|
1396 ;; Local variables for Dired buffers
|
|
|
1397
|
|
|
1398 (defvar dired-local-variables-file ".dired"
|
|
|
1399 "If non-nil, filename for local variables for Dired.
|
|
|
1400 If Dired finds a file with that name in the current directory, it will
|
|
|
1401 temporarily insert it into the dired buffer and run `hack-local-variables'.
|
|
|
1402
|
|
2
|
1403 Type \\[info] and `g' `(emacs)File Variables' `RET' for more info on
|
|
0
|
1404 local variables.")
|
|
|
1405
|
|
|
1406 (defun dired-hack-local-variables ()
|
|
|
1407 "Parse, and bind or evaluate as appropriate, any local variables
|
|
|
1408 for current dired buffer.
|
|
|
1409 See variable `dired-local-variables-file'."
|
|
|
1410 (if (and dired-local-variables-file
|
|
|
1411 (file-exists-p dired-local-variables-file))
|
|
|
1412 (let (buffer-read-only opoint )
|
|
|
1413 (save-excursion
|
|
|
1414 (goto-char (point-max))
|
|
|
1415 (setq opoint (point-marker))
|
|
|
1416 (insert "\^L\n")
|
|
|
1417 (insert-file-contents dired-local-variables-file))
|
|
|
1418 (let ((buffer-file-name dired-local-variables-file))
|
|
|
1419 (hack-local-variables))
|
|
|
1420 ;; Must delete it as (eobp) is often used as test for last
|
|
|
1421 ;; subdir in dired.el.
|
|
|
1422 (delete-region opoint (point-max))
|
|
|
1423 (set-marker opoint nil))))
|
|
|
1424
|
|
|
1425 ;; Guess what shell command to apply to a file.
|
|
|
1426
|
|
|
1427 (defvar dired-guess-have-gnutar nil
|
|
|
1428 "*If non-nil, name of the GNU tar executable (e.g. \"tar\" or \"gnutar\").
|
|
|
1429 GNU tar's `z' switch is used for compressed tar files.
|
|
|
1430 If you don't have GNU tar, set this to nil: a pipe using `zcat' is then used.")
|
|
|
1431
|
|
|
1432 (defvar dired-make-gzip-quiet t
|
|
|
1433 "*If non-nil, pass -q to shell commands involving gzip this will override
|
|
|
1434 GZIP environment variable.")
|
|
|
1435
|
|
|
1436 (defvar dired-znew-switches nil
|
|
|
1437 "*If non-nil, a string of switches that will be passed to `znew'
|
|
|
1438 example: \"-K\"")
|
|
|
1439
|
|
|
1440 (defvar dired-auto-shell-command-alist-default
|
|
|
1441 (list
|
|
|
1442 (list "\\.tar$" (if dired-guess-have-gnutar
|
|
|
1443 (concat dired-guess-have-gnutar " xvf")
|
|
|
1444 "tar xvf"))
|
|
|
1445
|
|
|
1446 ;; regexps for compressed archives must come before the .Z rule to
|
|
|
1447 ;; be recognized:
|
|
|
1448 (list "\\.tar\\.Z$" (if dired-guess-have-gnutar
|
|
|
1449 (concat dired-guess-have-gnutar " zxvf")
|
|
|
1450 (concat "zcat * | tar xvf -"))
|
|
|
1451 ;; optional conversion to gzip (GNU zip) format
|
|
|
1452 (concat "znew"
|
|
|
1453 (if dired-make-gzip-quiet " -q")
|
|
|
1454 " " dired-znew-switches))
|
|
|
1455
|
|
|
1456 ;; gzip'ed (GNU zip) archives
|
|
|
1457 (list "\\.tar\\.g?z$\\|\\.tgz$" (if dired-guess-have-gnutar
|
|
|
1458 (concat dired-guess-have-gnutar " zxvf")
|
|
|
1459 ;; use `gunzip -qc' instead of `zcat' since some
|
|
|
1460 ;; people don't install GNU zip's version of zcat
|
|
|
1461 (concat "gunzip -qc * | tar xvf -")))
|
|
|
1462 '("\\.shar.Z$" "zcat * | unshar")
|
|
|
1463 ;; use `gunzip -c' instead of `zcat'
|
|
|
1464 '("\\.shar.g?z$" "gunzip -qc * | unshar")
|
|
|
1465 '("\\.ps$" "ghostview" "xv" "lpr")
|
|
|
1466 '("\\.ps.g?z$" "gunzip -qc * | ghostview -"
|
|
|
1467 ;; optional decompression
|
|
|
1468 (concat "gunzip" (if dired-make-gzip-quiet " -q")))
|
|
|
1469 '("\\.ps.Z$" "zcat * | ghostview -"
|
|
|
1470 ;; optional conversion to gzip (GNU zip) format
|
|
|
1471 (concat "znew"
|
|
|
1472 (if dired-make-gzip-quiet " -q")
|
|
|
1473 " " dired-znew-switches))
|
|
|
1474 '("\\.dvi$" "xdvi" "dvips")
|
|
|
1475 '("\\.au$" "play") ; play Sun audiofiles
|
|
|
1476 '("\\.mpg$" "mpeg_play")
|
|
|
1477 '("\\.dl$" "xdl") ; loop pictures
|
|
|
1478 '("\\.fli$" "xanim")
|
|
|
1479 '("\\.gl$" "xgrasp")
|
|
|
1480 '("\\.uu$" "uudecode")
|
|
|
1481 '("\\.hqx$" "mcvert")
|
|
|
1482 '("\\.sh$" "sh") ; execute shell scripts
|
|
|
1483 '("\\.xbm$" "bitmap") ; view X11 bitmaps
|
|
|
1484 '("\\.xpm$" "sxpm")
|
|
|
1485 '("\\.gp$" "gnuplot")
|
|
|
1486 '("\\.p[bgpn]m$" "xv")
|
|
|
1487 '("\\.gif$" "xv") ; view gif pictures
|
|
|
1488 '("\\.tif$" "xv")
|
|
|
1489 '("\\.jpg$" "xv")
|
|
|
1490 '("\\.fig$" "xfig") ; edit fig pictures
|
|
|
1491 '("\.tex$" "latex" "tex")
|
|
|
1492 '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi")
|
|
|
1493 (if (eq window-system 'x) ; under X, offer both...
|
|
|
1494 '("\\.dvi$" "xtex" "dvips") ; ...preview and printing
|
|
|
1495 '("\\.dvi$" "dvips"))
|
|
|
1496 '("\\.g?z$" (concat "gunzip" (if dired-make-gzip-quiet " -q" ""))) ; quiet?
|
|
|
1497 '("\\.Z$" "uncompress"
|
|
|
1498 ;; optional conversion to gzip (GNU zip) format
|
|
|
1499 (concat "znew" (if dired-make-gzip-quiet " -q") " " dired-znew-switches))
|
|
|
1500 ;; some popular archivers:
|
|
|
1501 '("\\.zoo$" "zoo x//")
|
|
|
1502 '("\\.zip$" "unzip")
|
|
|
1503 '("\\.lzh$" "lharc x")
|
|
|
1504 '("\\.arc$" "arc x")
|
|
|
1505 '("\\.shar$" "unshar") ; use "sh" if you don't have unshar
|
|
|
1506 )
|
|
|
1507
|
|
|
1508 "Default for variable `dired-auto-shell-command-alist' (which see).
|
|
|
1509 Set this to nil to turn off shell command guessing.")
|
|
|
1510
|
|
|
1511 (defvar dired-auto-shell-command-alist nil
|
|
|
1512 "*If non-nil, an alist of file regexps and their suggested commands.
|
|
|
1513 Dired shell commands will look up the name of a file in this list
|
|
|
1514 and suggest the matching command as default.
|
|
|
1515
|
|
|
1516 Each element of this list looks like
|
|
|
1517
|
|
|
1518 \(REGEXP COMMAND...\)
|
|
|
1519
|
|
|
1520 where each COMMAND can either be a string or a lisp expression that
|
|
|
1521 evaluates to a string. If several COMMANDs are given, the first one
|
|
|
1522 will be the default and minibuffer completion will use the given set.
|
|
|
1523
|
|
|
1524 These rules take precedence over the predefined rules in the variable
|
|
|
1525 `dired-auto-shell-command-alist-default' (to which they are prepended).
|
|
|
1526
|
|
|
1527 You can set this variable in your ~/.emacs. For example, to add
|
|
|
1528 rules for `.foo' and `.bar' files, write
|
|
|
1529
|
|
|
1530 \(setq dired-auto-shell-command-alist
|
|
|
1531 (list (list \"\\\\.foo$\" \"FOO-COMMAND\");; fixed rule
|
|
|
1532 ;; possibly more rules ...
|
|
|
1533 (list \"\\\\.bar$\";; rule with condition test
|
|
|
1534 '(if condition
|
|
|
1535 \"BAR-COMMAND-1\"
|
|
|
1536 \"BAR-COMMAND-2\")))\)
|
|
|
1537 ")
|
|
|
1538
|
|
|
1539 (setq dired-auto-shell-command-alist
|
|
|
1540 (if dired-auto-shell-command-alist;; join user and default value:
|
|
|
1541 (append dired-auto-shell-command-alist
|
|
|
1542 dired-auto-shell-command-alist-default)
|
|
|
1543 ;; else just copy the default value:
|
|
|
1544 dired-auto-shell-command-alist-default))
|
|
|
1545
|
|
|
1546 (defun dired-guess-default (files)
|
|
|
1547 ;; Guess a shell command for FILES.
|
|
|
1548 ;; Returns a command or a list of commands.
|
|
|
1549 ;; You may want to redefine this to try something smarter.
|
|
|
1550 (if (or (cdr files)
|
|
|
1551 (null dired-auto-shell-command-alist))
|
|
|
1552 nil ; If more than one file, don't guess
|
|
|
1553 (let* ((file (car files))
|
|
|
1554 (alist dired-auto-shell-command-alist)
|
|
|
1555 (case-fold-search nil) ; need search to be case-sensitive in order
|
|
|
1556 ; to distinguish between gzip'ed (`.z') and
|
|
|
1557 ; compressed (`.Z') files
|
|
|
1558 elt re cmds)
|
|
|
1559 (while alist
|
|
|
1560 (setq elt (car alist)
|
|
|
1561 re (car elt)
|
|
|
1562 alist (cdr alist))
|
|
|
1563 (if (string-match re file)
|
|
|
1564 (setq cmds (cdr elt)
|
|
|
1565 alist nil)))
|
|
|
1566 (cond ((not (cdr cmds)) (eval (car cmds))) ; single command
|
|
|
1567 (t (mapcar (function eval) cmds))))))
|
|
|
1568
|
|
|
1569 (defun dired-guess-shell-command (prompt files)
|
|
|
1570 ;;"Ask user with PROMPT for a shell command, guessing a default from FILES."
|
|
|
1571 (let ((default (dired-guess-default files))
|
|
|
1572 default-list old-history val (failed t))
|
|
|
1573 (if (not (featurep 'gmhist))
|
|
|
1574 (read-string prompt (if (listp default) (car default) default))
|
|
|
1575 ;; else we have gmhist
|
|
|
1576 (if (null default)
|
|
|
1577 (read-with-history-in 'dired-shell-command-history prompt)
|
|
|
1578 (or (boundp 'dired-shell-command-history)
|
|
|
1579 (setq dired-shell-command-history nil))
|
|
|
1580 (setq old-history dired-shell-command-history)
|
|
|
1581 (if (listp default)
|
|
|
1582 ;; more than one guess
|
|
|
1583 (setq default-list default
|
|
|
1584 default (car default)
|
|
|
1585 prompt (concat
|
|
|
1586 prompt
|
|
|
1587 (format "{%d guesses} " (length default-list))))
|
|
|
1588 ;; just one guess
|
|
|
1589 (setq default-list (list default)))
|
|
|
1590 (put 'dired-shell-command-history 'default default)
|
|
|
1591 ;; push guesses onto history so that they can be retrieved with M-p
|
|
|
1592 (setq dired-shell-command-history
|
|
|
1593 (append default-list dired-shell-command-history))
|
|
|
1594 ;; the unwind-protect returns VAL, and we too.
|
|
|
1595 (unwind-protect
|
|
|
1596 (progn
|
|
|
1597 (setq val (read-with-history-in
|
|
|
1598 'dired-shell-command-history prompt)
|
|
|
1599 failed nil)
|
|
|
1600 val)
|
|
|
1601 (progn
|
|
|
1602 ;; Undo pushing onto the history list so that an aborted
|
|
|
1603 ;; command doesn't get the default in the next command.
|
|
|
1604 (setq dired-shell-command-history old-history)
|
|
|
1605 (if (not failed)
|
|
|
1606 (or (equal val (car-safe dired-shell-command-history))
|
|
|
1607 (setq dired-shell-command-history
|
|
|
1608 (cons val dired-shell-command-history))))))))))
|
|
|
1609
|
|
|
1610 ;; redefine dired.el's version:
|
|
|
1611 (defun dired-read-shell-command (prompt arg files)
|
|
|
1612 "Read a dired shell command using generic minibuffer history.
|
|
|
1613 This command tries to guess a command from the filename(s)
|
|
|
1614 from the variable `dired-auto-shell-command-alist' (which see)."
|
|
|
1615 (dired-mark-pop-up
|
|
|
1616 nil 'shell files ; bufname type files
|
|
|
1617 'dired-guess-shell-command ; function &rest args
|
|
|
1618 (format prompt (dired-mark-prompt arg files)) files))
|
|
|
1619
|
|
|
1620
|
|
|
1621 ;; Byte-compile-and-load (requires jwz@lucid.com's new byte compiler)
|
|
|
1622 (defun dired-do-byte-compile-and-load (&optional arg)
|
|
|
1623 "Byte compile marked and load (or next ARG) Emacs lisp files.
|
|
|
1624 This requires jwz@lucid.com's new optimizing byte compiler."
|
|
|
1625 (interactive "P")
|
|
|
1626 (dired-mark-map-check (function dired-byte-compile-and-load) arg
|
|
|
1627 'byte-compile-and-load t))
|
|
|
1628
|
|
|
1629 (defun dired-byte-compile-and-load ()
|
|
|
1630 ;; Return nil for success, offending file name else.
|
|
|
1631 (let* (buffer-read-only
|
|
|
1632 (from-file (dired-get-filename))
|
|
|
1633 (new-file (byte-compile-dest-file from-file)))
|
|
|
1634 (if (not (string-match elisp-source-extention-re from-file))
|
|
|
1635 (progn
|
|
|
1636 (dired-log "Attempt to compile non-elisp file %s\n" from-file)
|
|
|
1637 ;; return a non-nil value as error indication
|
|
|
1638 (dired-make-relative from-file))
|
|
|
1639 (save-excursion;; Jamie's compiler may switch buffer
|
|
|
1640 (byte-compile-and-load-file from-file))
|
|
|
1641 (dired-remove-file new-file)
|
|
|
1642 (forward-line) ; insert .elc after its .el file
|
|
|
1643 (dired-add-file new-file)
|
|
|
1644 nil)))
|
|
|
1645
|
|
|
1646 ;; Visit all marked files simultaneously.
|
|
|
1647 ;; After an idea by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
|
|
|
1648
|
|
|
1649 (defun dired-do-find-file (&optional arg)
|
|
|
1650 "Visit all marked files at once, and display them simultaneously.
|
|
|
1651 See also function `simultaneous-find-file'.
|
|
|
1652 If you want to keep the dired buffer displayed, type \\[split-window-vertically] first.
|
|
|
1653 If you want just the marked files displayed and nothing else, type \\[delete-other-windows] first."
|
|
|
1654 (interactive "P")
|
|
|
1655 (simultaneous-find-file (dired-mark-get-files nil arg)))
|
|
|
1656
|
|
|
1657 (defun simultaneous-find-file (file-list)
|
|
|
1658 "Visit all files in FILE-LIST and display them simultaneously.
|
|
|
1659
|
|
|
1660 The current window is split across all files in FILE-LIST, as evenly
|
|
|
1661 as possible. Remaining lines go to the bottommost window.
|
|
|
1662
|
|
|
1663 The number of files that can be displayed this way is restricted by
|
|
|
1664 the height of the current window and the variable `window-min-height'."
|
|
|
1665 ;; It is usually too clumsy to specify FILE-LIST interactively
|
|
|
1666 ;; unless via dired (dired-do-find-file).
|
|
|
1667 (let ((size (/ (window-height) (length file-list))))
|
|
|
1668 (or (<= window-min-height size)
|
|
|
1669 (error "Too many files to visit simultaneously"))
|
|
|
1670 (find-file (car file-list))
|
|
|
1671 (setq file-list (cdr file-list))
|
|
|
1672 (while file-list
|
|
|
1673 ;; Split off vertically a window of the desired size
|
|
|
1674 ;; The upper window will have SIZE lines. We select the lower
|
|
|
1675 ;; (larger) window because we want to split that again.
|
|
|
1676 (select-window (split-window nil size))
|
|
|
1677 (find-file (car file-list))
|
|
|
1678 (setq file-list (cdr file-list)))))
|
