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