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