lisp/dired-x.el

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