lisp/dired-x.el

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