comparison lisp/dired-x.el @ 5426:a0e483109eaa

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