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