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