home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / dired / dired-x.el < prev    next >
Encoding:
Text File  |  1992-12-10  |  60.2 KB  |  1,621 lines
  1. ;; dired-x.el - Extra DIRED commands for Emacs.
  2.  
  3. (defconst dired-extra-version (substring "!Revision: 1.191 !" 11 -2)
  4.   "Id: dired-x.el,v 1.191 1992/05/14 11:41:54 sk RelBeta ")
  5.   
  6. ;; Copyright (C) 1991 Sebastian Kremer.
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 1, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  25. ;;    LCD Archive Entry:
  26. ;;    dired-x|Sebastian Kremer|sk@thp.uni-koeln.de
  27. ;;    |Extra Features for Tree Dired
  28. ;;    |Date: 1992/05/14 11:41:54 |Revision: 1.191 |
  29.  
  30. ;; INSTALLATION ======================================================
  31.  
  32. ;; In your ~/.emacs, say
  33. ;;
  34. ;;       (setq dired-load-hook '(lambda () (load "dired-x")))
  35. ;;
  36. ;; At load time dired-x will install itself using the various other
  37. ;; dired hooks.  It will redefine some functions and bind dired keys.
  38. ;; If gmhist is present, dired-x will take advantage of it.
  39.  
  40. (require 'dired)            ; we will redefine some functions
  41.                     ; and also need some macros
  42.  
  43. (provide 'dired-extra)            ; but this file is "dired-x"
  44.  
  45. ;; Customization (see also defvars in other sections below)
  46.  
  47. (defvar dired-mark-keys '("Z")
  48.   "*List of keys (strings) that insert themselves as file markers.")
  49.  
  50. (defvar dired-dangerous-shell-command "^rm" ; e.g. "rm" or "rmdir"
  51.   "*Regexp for dangerous shell commands that should never be the default.")
  52.  
  53. ;; Add key bindings.  This file is supposed to be loaded immediately
  54. ;; after dired, inside dired-load-hook.
  55.  
  56. (define-key dired-mode-map "V" 'dired-vm)
  57. (define-key dired-mode-map "\(" 'dired-set-marker-char)
  58. (define-key dired-mode-map "\)" 'dired-restore-marker-char)
  59. (define-key dired-mode-map "I" 'dired-do-insert-subdir)
  60. ;;(define-key dired-mode-map "\M-f" 'dired-flag-extension)
  61. (define-key dired-mode-map "\M-M" 'dired-do-unmark)
  62. (define-key dired-mode-map "\M-o" 'dired-omit-toggle)
  63. (define-key dired-mode-map "\M-(" 'dired-mark-sexp)
  64. (define-key dired-mode-map "," 'dired-mark-rcs-files)
  65. (define-key dired-mode-map "\M-!" 'dired-smart-shell-command)
  66. (define-key dired-mode-map "\M-&" 'dired-smart-background-shell-command)
  67. (define-key dired-mode-map "T" 'dired-do-toggle)
  68. (define-key dired-mode-map "w" 'dired-copy-filename-as-kill)
  69. (define-key dired-mode-map "\M-g" 'dired-goto-file)
  70. (define-key dired-mode-map "\M-G" 'dired-goto-subdir)
  71. (define-key dired-mode-map "&" 'dired-do-background-shell-command)
  72. (define-key dired-mode-map "A" 'dired-do-byte-compile-and-load)
  73. (define-key dired-mode-map "F" 'dired-do-find-file)
  74. (define-key dired-mode-map "S" 'dired-do-relsymlink)
  75. (define-key dired-mode-map "%S" 'dired-do-relsymlink-regexp)
  76.  
  77. (mapcar (function;; do this last to override bindings above
  78.      (lambda (x)
  79.        (define-key dired-mode-map x 'dired-mark-with-this-char)))
  80.     dired-mark-keys)
  81.  
  82. ;; Install ourselves into the appropriate hooks
  83.  
  84. (defun dired-add-hook (hook-var function)
  85.   "Add a function to a hook.
  86. First argument HOOK-VAR (a symbol) is the name of a hook, second
  87. argument FUNCTION is the function to add.
  88. Returns nil if FUNCTION was already present in HOOK-VAR, else new
  89. value of HOOK-VAR."
  90.   (interactive "SAdd to hook-var (symbol): \naAdd which function to %s? ")
  91.   (if (not (boundp hook-var)) (set hook-var nil))
  92.   (if (or (not (listp (symbol-value hook-var)))
  93.       (eq (car (symbol-value hook-var)) 'lambda))
  94.       (set hook-var (list (symbol-value hook-var))))
  95.   (if (memq function (symbol-value hook-var))
  96.       nil
  97.     (set hook-var (cons function (symbol-value hook-var)))))
  98.  
  99. (dired-add-hook 'dired-mode-hook 'dired-extra-startup)
  100. (dired-add-hook 'dired-after-readin-hook 'dired-omit-expunge)
  101.  
  102. (defvar dired-default-marker dired-marker-char
  103.   "*The value of `dired-marker-char' in effect before dired-x was
  104. loaded and the value which is restored if the marker stack underflows.
  105. This is usually the asterisk `*'.")
  106.  
  107. (defun dired-extra-startup ()
  108.   "Automatically put on dired-mode-hook to get extra dired features:
  109. \\<dired-mode-map>
  110.   \\[dired-vm]\t-- VM on folder
  111.   \\[dired-rmail]\t-- Rmail on folder
  112.   \\[dired-do-insert-subdir]\t-- insert all marked subdirs
  113.   \\[dired-do-find-file]\t-- visit all marked files simultaneously
  114.   \\[dired-set-marker-char], \\[dired-restore-marker-char]\t-- change and display dired-marker-char dynamically.
  115.   \\[dired-omit-toggle]\t-- toggle omitting of files
  116.   \\[dired-mark-sexp]\t-- mark by lisp expression
  117.   \\[dired-do-unmark]\t-- replace existing marker with another.
  118.   \\[dired-mark-rcs-files]\t-- mark all RCS controlled files
  119.   \\[dired-mark-files-compilation-buffer]\t-- mark compilation files
  120.   \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring.
  121.   \t   You can feed it to other commands using \\[yank].
  122.  
  123. For more features, see variables
  124.  
  125.   dired-omit-files
  126.   dired-omit-extenstions
  127.   dired-dangerous-shell-command
  128.   dired-mark-keys
  129.   dired-local-variables-file
  130.   dired-find-subdir
  131.   dired-guess-have-gnutar
  132.   dired-auto-shell-command-alist
  133.  
  134. See also functions
  135.  
  136.   dired-sort-on-size
  137.   dired-do-relsymlink
  138.   dired-flag-extension
  139.   dired-virtual
  140.   dired-jump-back
  141.   dired-jump-back-other-window
  142. "
  143.   (interactive)
  144.   ;; This must be done in each new dired buffer:
  145.   (dired-hack-local-variables)
  146.   (dired-omit-startup)
  147.   (dired-marker-stack-startup))
  148.  
  149. ;;; Handle customization
  150.  
  151. (or (fboundp 'read-with-history-in)    ; it's loaded
  152.     (not (subrp (symbol-function 'read-from-minibuffer)))    ; it's 19.4L
  153.     ;; else try to load gmhist
  154.     (load "gmhist" t))
  155.  
  156. (if (not (fboundp 'read-with-history-in))
  157.  
  158.     nil                    ; Gmhist is not available
  159.  
  160.   ;; Else use generic minibuffer history
  161.   (put 'dired-shell-command-history 'dangerous dired-dangerous-shell-command)
  162.  
  163.   ;; Redefinition - when this is loaded, dired.el has alreay been loaded.
  164.  
  165.   (defun dired-read-regexp (prompt &optional initial)
  166.     (setq dired-flagging-regexp
  167.       (if (null initial)
  168.           (read-with-history-in 'regexp-history prompt initial)
  169.         (put 'regexp-history 'default
  170.          nil)
  171.         (put 'regexp-history 'default
  172.          (read-with-history-in 'regexp-history prompt initial)))))
  173.  
  174.   (defun dired-read-dir-and-switches (str)
  175.     (nreverse
  176.      (list
  177.       (if current-prefix-arg
  178.       (read-string "Dired listing switches: " dired-listing-switches))
  179.       (read-file-name-with-history-in
  180.        'file-history            ; or 'dired-history?
  181.        (format "Dired %s(directory): " str) nil default-directory nil))))
  182. )
  183.  
  184.  
  185.  
  186. ;;; Dynamic Markers
  187.  
  188. (defun dired-mark-with-this-char (arg)
  189.   "Mark the current file or subdir with the last key you pressed to invoke
  190. this command.  Else like \\[dired-mark-subdir-or-file] command."
  191.   (interactive "p")
  192.   (let ((dired-marker-char;; use last character, in case of prefix cmd
  193.      last-command-char))
  194.     (dired-mark-subdir-or-file arg)))
  195.  
  196. (defvar dired-marker-stack nil
  197.   "List of previously used dired marker characters.")
  198.  
  199. (defvar dired-marker-string ""
  200.   "String version of `dired-marker-stack'.")
  201.  
  202. (defun dired-current-marker-string ()
  203.   "Computes and returns `dired-marker-string'."
  204.   (setq dired-marker-string
  205.     (concat " "
  206.         (mapconcat (function char-to-string)
  207.                (reverse dired-marker-stack)
  208.                ""))))
  209.  
  210. (defun dired-marker-stack-startup ()
  211.   (make-local-variable 'dired-marker-char)
  212.   (make-local-variable 'dired-del-marker)
  213.   (make-local-variable 'dired-marker-stack)
  214.   (or (assq 'dired-marker-stack minor-mode-alist)
  215.       (setq minor-mode-alist
  216.         (cons '(dired-marker-stack dired-marker-string)
  217.           minor-mode-alist))))
  218.  
  219. (defun dired-set-marker-char (c)
  220.   "Set the marker character to something else.
  221. Use \\[dired-restore-marker-char] to restore the previous value."
  222.   (interactive "cNew marker character: ")
  223.   (setq dired-marker-stack (cons c dired-marker-stack))
  224.   (dired-current-marker-string)
  225.   (setq dired-marker-char c)
  226.   (set-buffer-modified-p (buffer-modified-p)) ; update mode line
  227.   (message "New marker is %c" dired-marker-char))
  228.  
  229. (defun dired-restore-marker-char ()
  230.   "Restore the marker character to its previous value.
  231. Uses `dired-default-marker' if the marker stack is empty."
  232.   (interactive)
  233.   (setq dired-marker-stack (cdr dired-marker-stack)
  234.     dired-marker-char (car dired-marker-stack))
  235.   (dired-current-marker-string)
  236.   (set-buffer-modified-p (buffer-modified-p)) ; update mode line
  237.   (or dired-marker-char (setq dired-marker-char dired-default-marker))
  238.   (message "Marker is %c" dired-marker-char))
  239.  
  240. ;;; Sort on Size kludge if your ls can't do it
  241.  
  242. (defun dired-sort-on-size ()
  243.   "Sorts a dired listing on file size.
  244. If your ls cannot sort on size, this is useful as `dired-after-readin-hook':
  245.     \(setq dired-after-readin-hook 'dired-sort-on-size\)"
  246.   (require 'sort)
  247.   (goto-char (point-min))
  248.   (dired-goto-next-file)        ; skip `total' line
  249.   (beginning-of-line)
  250.   (sort-subr t                ; biggest file first
  251.          'forward-line 'end-of-line 'dired-get-file-size))
  252.  
  253. (defun dired-get-file-size ()
  254.   (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)")
  255.   (goto-char (match-beginning 1))
  256.   (forward-char -1)
  257.   (string-to-int (buffer-substring (save-excursion
  258.                      (backward-word 1)
  259.                      (point))
  260.                    (point))))
  261.  
  262.  
  263. ;;; Misc. (mostly featurismic) commands
  264.  
  265. ;; Mail folders
  266.  
  267. (defvar dired-vm-read-only-folders nil
  268.   "*If t, \\[dired-vm] will visit all folders read-only.
  269. If neither nil nor t, e.g. the symbol `if-file-read-only', only
  270. files not writable by you are visited read-only.
  271.  
  272. Read-only folders only work in VM 5, not in VM 4.")
  273.  
  274. (defun dired-vm (&optional read-only)
  275.   "Run VM on this file.
  276. With prefix arg, visit folder read-only (this requires at least VM 5).
  277. See also variable `dired-vm-read-only-folders'."
  278.   (interactive "P")
  279.   (let ((dir (dired-current-directory))
  280.     (fil (dired-get-filename)))
  281.     ;; take care to supply 2nd arg only if requested - may still run VM 4!
  282.     (cond (read-only (vm-visit-folder fil t))
  283.       ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t))
  284.       ((null dired-vm-read-only-folders) (vm-visit-folder fil))
  285.       (t (vm-visit-folder fil (not (file-writable-p fil)))))
  286.     ;; so that pressing `v' inside VM does prompt within current directory:
  287.     (set (make-local-variable 'vm-folder-directory) dir)))
  288.  
  289. (defun dired-rmail ()
  290.   "Run RMAIL on this file."
  291.   (interactive)
  292.   (rmail (dired-get-filename)))
  293.  
  294. ;; More subdir operations
  295.  
  296. (defun dired-do-insert-subdir ()
  297.   "Insert all marked subdirectories in situ that are not yet inserted.
  298. Non-directories are silently ignored."
  299.   (interactive)
  300.   (let ((files (or (dired-mark-get-files)
  301.            (error "No files marked."))))
  302.     (while files
  303.       (if (file-directory-p (car files))
  304.       (save-excursion (dired-maybe-insert-subdir (car files))))
  305.       (setq files (cdr files)))))
  306.  
  307. (defun dired-mark-extension (extension &optional marker-char)
  308.   "Mark all files with a certain extension for use in later commands.
  309. A `.' is not automatically prepended to the string entered."
  310.   ;; EXTENSION may also be a list of extensions instead of a single one.
  311.   ;; Optional MARKER-CHAR is marker to use.
  312.   (interactive "sMarking extension: \nP")
  313.   (or (listp extension)
  314.       (setq extension (list extension)))
  315.   (dired-mark-files-regexp
  316.    (concat ".";; don't match names with nothing but an extension
  317.        "\\("
  318.        (mapconcat 'regexp-quote extension "\\|")
  319.        "\\)$")
  320.    marker-char))
  321.  
  322. (defun dired-flag-extension (extension)
  323.   "In dired, flag all files with a certain extension for deletion.
  324. A `.' is *not* automatically prepended to the string entered."
  325.   (interactive "sFlagging extension: ")
  326.   (dired-mark-extension extension dired-del-marker))
  327.  
  328. (defvar patch-unclean-extensions
  329.   '(".rej" ".orig")
  330.   "List of extensions of dispensable files created by the `patch' program.")
  331.  
  332. (defvar tex-unclean-extensions
  333.   '(".toc" ".log" ".aux");; these are already in completion-ignored-extensions
  334.   "List of extensions of dispensable files created by TeX.")
  335.  
  336. (defvar latex-unclean-extensions
  337.   '(".idx" ".lof" ".lot" ".glo")
  338.   "List of extensions of dispensable files created by LaTeX.")
  339.  
  340. (defvar bibtex-unclean-extensions
  341.   '(".blg" ".bbl")
  342.   "List of extensions of dispensable files created by BibTeX.")
  343.  
  344. (defvar texinfo-unclean-extensions
  345.   '(".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs"
  346.     ".tp" ".tps" ".vr" ".vrs")
  347.   "List of extensions of dispensable files created by texinfo.")
  348.  
  349. (defun dired-clean-patch ()
  350.   "Flag dispensable files created by patch for deletion.
  351. See variable `patch-unclean-extensions'."
  352.   (interactive)
  353.   (dired-flag-extension patch-unclean-extensions))
  354.  
  355. (defun dired-clean-tex ()
  356.   "Flag dispensable files created by tex etc. for deletion.
  357. See variable `texinfo-unclean-extensions', `latex-unclean-extensions',
  358. `bibtex-unclean-extensions' and `texinfo-unclean-extensions'."
  359.   (interactive)
  360.   (dired-flag-extension (append texinfo-unclean-extensions
  361.                 latex-unclean-extensions
  362.                 bibtex-unclean-extensions
  363.                 tex-unclean-extensions)))
  364.  
  365. (defun dired-do-unmark (unmarker)
  366.   "Unmark marked files by replacing the marker with another character.
  367. The new character defaults to a space, effectively unmarking them."
  368.   (interactive "sChange marker to: ")
  369.   (if (string= unmarker "")
  370.       (setq unmarker " "))
  371.   (setq unmarker (substring unmarker 0 1))
  372.   (let ((regexp (dired-marker-regexp))
  373.     (buffer-read-only nil))
  374.     (save-excursion
  375.       (goto-char (point-min))
  376.       (while (re-search-forward regexp nil t)
  377.     (replace-match unmarker)))))
  378.  
  379. ;; This is unused but might come in handy sometime
  380. ;(defun dired-directories-of (files)
  381. ;  ;; Return unique list of parent directories of FILES.
  382. ;  (let (dirs dir file)
  383. ;    (while files
  384. ;      (setq file (car files)
  385. ;        files (cdr files)
  386. ;        dir (file-name-directory file))
  387. ;      (or (member dir dirs)
  388. ;      (setq dirs (cons dir dirs))))
  389. ;    dirs))
  390.  
  391. ;; Adapted from code by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
  392. ;; Suggest you bind it to a key.  I use C-x C-j.
  393. (defun dired-jump-back (&optional other-window)
  394.   "Jump back to dired:
  395. If in a file, dired the current directory and move to file's line.
  396. If in dired already, pop up a level and goto old directory's line.
  397. In case the proper dired file line cannot be found, refresh the dired
  398.   buffer and try again."
  399.   (interactive)
  400.   (let* ((file buffer-file-name)
  401.      (dir (if file (file-name-directory file) default-directory)))
  402.     (if (eq major-mode 'dired-mode)
  403.     (progn
  404.       (setq dir (dired-current-directory))
  405.       (if other-window
  406.           (dired-up-directory-other-window)
  407.         (dired-up-directory))
  408.       (dired-really-goto-file dir))
  409.       (if other-window
  410.       (dired-other-window dir)
  411.     (dired dir))
  412.       (if file (dired-really-goto-file file)))))
  413.  
  414. (defun dired-jump-back-other-window ()
  415.   "Like \\[dired-jump-back], but to other window."
  416.   (interactive)
  417.   (dired-jump-back t))
  418.  
  419. (defun dired-really-goto-file (file)
  420.   (or (dired-goto-file file)
  421.       (progn                ; refresh and try again
  422.     (dired-insert-subdir (file-name-directory file))
  423.     (dired-goto-file file))))
  424.  
  425. (defun dired-up-directory-other-window ()
  426.   "Like `dired-up-directory', but in other window."
  427.   (interactive)
  428.   (let* ((dir (dired-current-directory))
  429.      (up (file-name-directory (directory-file-name dir))))
  430.     (or (dired-goto-file (directory-file-name dir))
  431.     (dired-goto-subdir up)
  432.     ;; Only in this case it really uses another window:
  433.     (progn
  434.       (dired-other-window up)
  435.       (dired-goto-file dir)))))
  436.  
  437. (defun dired-mark-rcs-files (&optional unflag-p)
  438.   "Mark all files that are under RCS control.
  439. With prefix argument, unflag all those files.
  440. Mentions RCS files for which a working file was not found in this buffer.
  441. Type \\[dired-why] to see them again."
  442.   ;; Returns failures, or nil on success.
  443.   ;; Finding those with locks would require to peek into the ,v file,
  444.   ;; depends slightly on the RCS version used and should be done
  445.   ;; together with the Emacs RCS interface.
  446.   ;; Unfortunately, there is no definitive RCS interface yet.
  447.   (interactive "P")
  448.   (message "%sarking RCS controlled files..." (if unflag-p "Unm" "M"))
  449.   (let ((dired-marker-char (if unflag-p ?\  dired-marker-char))
  450.     rcs-files wf failures count total)
  451.     (mapcar                ; loop over subdirs
  452.      (function
  453.       (lambda (dir)
  454.     (or (equal (file-name-nondirectory (directory-file-name dir))
  455.            "RCS")
  456.         ;; skip inserted RCS subdirs
  457.         (setq rcs-files
  458.           (append (directory-files dir t ",v$") ; *,v and RCS/*,v
  459.               (let ((rcs-dir (expand-file-name "RCS" dir)))
  460.                 (if (file-directory-p rcs-dir)
  461.                 (mapcar    ; working files from ./RCS are in ./
  462.                  (function
  463.                   (lambda (x)
  464.                     (expand-file-name x dir)))
  465.                  (directory-files
  466.                   (file-name-as-directory rcs-dir) nil ",v$"))))
  467.               rcs-files)))))
  468.      (mapcar (function car) dired-subdir-alist))
  469.     (setq total (length rcs-files))
  470.     (while rcs-files
  471.       (setq wf (substring (car rcs-files) 0 -2)
  472.         rcs-files (cdr rcs-files))
  473.       (save-excursion (if (dired-goto-file wf)
  474.               (dired-mark-file 1)
  475.             (setq failures (cons wf failures)))))
  476.     (if (null failures)
  477.     (message "%d RCS file%s %smarked."
  478.          total (dired-plural-s total) (if unflag-p "un" ""))
  479.       (setq count (length failures))
  480.       (dired-log-summary "RCS working file not found %s" failures)
  481.       (message "%d RCS file%s: %d %smarked - %d not found %s."
  482.            total (dired-plural-s total) (- total count)
  483.            (if unflag-p "un" "") count failures))
  484.     failures))
  485.  
  486. (defun dired-do-toggle ()
  487.   "Toggle marks.
  488. That is, currently marked files become unmarked and vice versa.
  489. Files marked with other flags (such as `D') are not affected.
  490. `.' and `..' are never toggled.
  491. As always, hidden subdirs are not affected."
  492.   (interactive)
  493.   (save-excursion
  494.     (goto-char (point-min))
  495.     (let (buffer-read-only)
  496.       (while (not (eobp))
  497.     (or (dired-between-files)
  498.         (looking-at dired-re-dot)
  499.         ;; use subst instead of insdel because it does not move
  500.         ;; the gap and thus should be faster and because
  501.         ;; other characters are left alone automatically
  502.         (apply 'subst-char-in-region
  503.            (point) (1+ (point))
  504.            (if (eq ?\040 (following-char)) ; SPC
  505.                (list ?\040 dired-marker-char)
  506.              (list dired-marker-char ?\040))))
  507.     (forward-line 1)))))
  508.  
  509. ;; This function is missing in simple.el
  510. (defun copy-string-as-kill (string)
  511.   "Save STRING as if killed in a buffer."
  512.   (setq kill-ring (cons string kill-ring))
  513.   (if (> (length kill-ring) kill-ring-max)
  514.     (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
  515.   (setq kill-ring-yank-pointer kill-ring))
  516.  
  517. (defvar dired-marked-files nil
  518.   "List of filenames from last `dired-copy-filename-as-kill' call.")
  519.  
  520. (defun dired-copy-filename-as-kill (&optional arg)
  521.   "Copy names of marked (or next ARG) files into the kill ring.
  522. The names are separated by a space.
  523. With a zero prefix arg, use the complete pathname of each marked file.
  524. With a raw (just \\[universal-argument]) prefix arg, use the relative pathname of each marked file.
  525.  
  526. If on a subdir headerline and no prefix arg given, use subdirname instead.
  527.  
  528. You can then feed the file name to other commands with \\[yank].
  529.  
  530. The list of names is also stored onto the variable
  531. `dired-marked-files' for use, e.g., in an `\\[eval-expression]' command."
  532.   (interactive "P")
  533.   (copy-string-as-kill
  534.    (or (and (not arg)
  535.         (dired-get-subdir))
  536.        (mapconcat (function identity)
  537.           (setq dired-marked-files
  538.             (if arg
  539.                 (cond ((zerop (prefix-numeric-value arg))
  540.                    (dired-mark-get-files))
  541.                   ((integerp arg)
  542.                    (dired-mark-get-files 'no-dir arg))
  543.                   (t    ; else a raw arg
  544.                    (dired-mark-get-files t)))
  545.               (dired-mark-get-files 'no-dir)))
  546.           " ")))
  547.   (message "%s" (car kill-ring)))
  548.  
  549. (defun dired-do-background-shell-command (&optional arg)
  550.   "Like \\[dired-do-shell-command], but starts command in background.
  551. Note that you can type input to the command in its buffer.
  552. This requires background.el from the comint package to work."
  553.   ;; With the version in emacs-19.el, you can alternatively just
  554.   ;; append an `&' to any shell command to make it run in the
  555.   ;; background, but you can't type input to it.
  556.   (interactive "P")
  557.   (dired-do-shell-command arg t))
  558.  
  559. ;; redefines dired.el to put back in the dired-offer-kill-buffer
  560. ;; feature which rms didn't like.
  561. (defun dired-clean-up-after-deletion (fn)
  562.   ;; Clean up after a deleted file or directory FN.
  563.   ;; Remove expanded subdir of deleted dir, if any
  564.   (save-excursion (and (dired-goto-subdir fn)
  565.                (dired-kill-subdir)))
  566.   ;; Offer to kill buffer of deleted file FN.
  567.   (let ((buf (get-file-buffer fn)))
  568.     (and buf
  569.      (funcall (function y-or-n-p)
  570.           (format "Kill buffer of %s, too? "
  571.               (file-name-nondirectory fn)))
  572.      (save-excursion;; you never know where kill-buffer leaves you
  573.        (kill-buffer buf))))
  574.   (let ((buf-list (dired-buffers-for-top-dir fn))
  575.     (buf nil))
  576.     (and buf-list
  577.      (y-or-n-p (format "Kill dired buffer%s of %s, too? "
  578.                (dired-plural-s (length buf-list))
  579.                (file-name-nondirectory fn)))
  580.      (while buf-list
  581.        (save-excursion (kill-buffer (car buf-list)))
  582.        (setq buf-list (cdr buf-list)))))
  583.   ;; Anything else?
  584.   )
  585.  
  586. ;;; Omitting
  587.  
  588. ;;; Enhanced omitting of lines from directory listings.
  589. ;;; Marked files are never omitted.
  590. ;;; Adapted from code submitted by:
  591. ;;; Michael D. Ernst, mernst@theory.lcs.mit.edu, 1/11/91
  592.  
  593. (defvar dired-omit-files-p nil
  594.   "*If non-nil, \"uninteresting\" files are not listed (buffer-local).
  595. Use \\[dired-omit-toggle] to toggle its value.
  596. Uninteresting files are those whose filenames match regexp `dired-omit-files',
  597. plus those ending with extensions in `dired-omit-extensions'.")
  598.  
  599. (defvar dired-omit-files "^#\\|\\.$"
  600.   "*Filenames matching this regexp will not be displayed (buffer-local).
  601. This only has effect when `dired-omit-files-p' is t.
  602. See also `dired-omit-extensions'.")
  603.  
  604. (defvar dired-omit-extensions
  605.   (append completion-ignored-extensions
  606.       latex-unclean-extensions
  607.       bibtex-unclean-extensions
  608.       texinfo-unclean-extensions)
  609.   "*If non-nil, a list of extensions (strings) to omit from Dired
  610. listings.  Defaults to the elements of
  611. `completion-ignored-extensions', `latex-unclean-extensions',
  612. `bibtex-unclean-extensions' and `texinfo-unclean-extensions'.")
  613.  
  614. ;; should probably get rid of this and always use 'no-dir.
  615. ;; sk 28-Aug-1991 09:37
  616. (defvar dired-omit-localp 'no-dir
  617.   "The LOCALP argument dired-omit-expunge passes to dired-get-filename.
  618. If it is 'no-dir, omitting is much faster, but you can only match
  619. against the basename of the file.  Set it to nil if you need to match the
  620. whole pathname.")
  621.  
  622. ;; \017=^O for Omit - other packages can chose other control characters.
  623. (defvar dired-omit-marker-char ?\017
  624.   "Temporary marker used by by dired-omit.
  625. Should never be used as marker by the user or other packages.")
  626.  
  627. (defun dired-omit-startup ()
  628.   (make-local-variable 'dired-omit-files-p)
  629.   (or (assq 'dired-omit-files-p minor-mode-alist)
  630.       ;; Append at end so that it doesn't get between "Dired" and "by name".
  631.       (setq minor-mode-alist
  632.         (append minor-mode-alist '((dired-omit-files-p " Omit"))))))
  633.  
  634. (defun dired-omit-toggle (&optional flag)
  635.   "Toggle between displaying and omitting files matching `dired-omit-files'.
  636. With an arg, and if omitting was off, don't toggle and just mark the
  637.   files but don't actually omit them.
  638. With an arg, and if omitting was on, turn it off but don't refresh the buffer."
  639.   (interactive "P")
  640.   (if flag
  641.       (if dired-omit-files-p
  642.       (setq dired-omit-files-p (not dired-omit-files-p))
  643.     (dired-mark-unmarked-files (dired-omit-regexp) nil nil
  644.                    dired-omit-localp))
  645.     ;; no FLAG
  646.     (setq dired-omit-files-p (not dired-omit-files-p))
  647.     (if (not dired-omit-files-p)
  648.     (revert-buffer)
  649.       ;; this will mention how many were omitted:
  650.       (dired-omit-expunge))))
  651.  
  652. ;; This is sometimes let-bound to t if messages would be annoying,
  653. ;; e.g., in dired-awrh.el.
  654. (defvar dired-omit-silent nil)
  655.  
  656. (defun dired-omit-expunge (&optional regexp)
  657.   "Erases all unmarked files matching REGEXP.
  658. Does nothing if global variable `dired-omit-files-p' is nil.
  659. If REGEXP is nil or not specified, uses `dired-omit-files', and also omits
  660.   filenames ending in `dired-omit-extensions'.
  661. If REGEXP is the empty string, this function is a no-op.
  662.  
  663. This functions works by temporarily binding `dired-marker-char' to
  664. `dired-omit-marker-char' and calling `dired-do-kill'."
  665.   (interactive "sOmit files (regexp): ")
  666.   (if dired-omit-files-p
  667.      (let ((omit-re (or regexp (dired-omit-regexp)))
  668.        count)
  669.        (or (string= omit-re "")
  670.        (let ((dired-marker-char dired-omit-marker-char))
  671.          (or dired-omit-silent (message "Omitting..."))
  672.          (if (dired-mark-unmarked-files
  673.           omit-re nil nil dired-omit-localp)
  674.          (setq count (dired-do-kill nil (if dired-omit-silent
  675.                             ""
  676.                           "Omitted %d line%s.")))
  677.            (or dired-omit-silent
  678.            (message "(Nothing to omit)")))))
  679.        count)))
  680.  
  681. (defun dired-omit-regexp ()
  682.   (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
  683.       (if (and dired-omit-files dired-omit-extensions) "\\|" "")
  684.       (if dired-omit-extensions
  685.           (concat ".";; a non-extension part should exist
  686.               "\\("
  687.               (mapconcat 'regexp-quote dired-omit-extensions "\\|")
  688.               "\\)$")
  689.         "")))
  690.  
  691. ;; Returns t if any work was done, nil otherwise.
  692. (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
  693.   "Marks unmarked files matching REGEXP, displaying MSG.
  694. REGEXP is matched against the complete pathname.
  695. Does not re-mark files which already have a mark.
  696. With prefix argument, unflag all those files.
  697. Second optional argument LOCALP is as in `dired-get-filename'."
  698.   (interactive "P")
  699.   (let ((dired-marker-char (if unflag-p ?\  dired-marker-char)))
  700.     (dired-mark-if
  701.      (and
  702.       ;; not already marked
  703.       (looking-at " ")
  704.       ;; uninteresting
  705.       (let ((fn (dired-get-filename localp t)))
  706.     (and fn (string-match regexp fn))))
  707.      msg)))
  708.  
  709. (defun dired-omit-new-add-entry (filename &optional marker-char)
  710.   ;; This redefines dired.el's dired-add-entry to avoid calling ls for
  711.   ;; files that are going to be omitted anyway.
  712.   (if dired-omit-files-p
  713.       ;; perhaps return t without calling ls
  714.       (let ((omit-re (dired-omit-regexp)))
  715.     (if (or (string= omit-re "")
  716.         (not
  717.          (string-match omit-re
  718.                    (cond
  719.                 ((eq 'no-dir dired-omit-localp)
  720.                  filename)
  721.                 ((eq t dired-omit-localp)
  722.                  (dired-make-relative filename))
  723.                 (t
  724.                  (dired-make-absolute filename directory))))))
  725.         ;; if it didn't match, go ahead and add the entry
  726.         (dired-omit-old-add-entry filename marker-char)
  727.       ;; dired-add-entry returns t for success, perhaps we should
  728.       ;; return file-exists-p
  729.       t))
  730.     ;; omitting is not turned on at all
  731.     (dired-omit-old-add-entry filename marker-char)))
  732.  
  733. ;; Save old defun if not already done:
  734. (or (fboundp 'dired-omit-old-add-entry)
  735.     (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry)))
  736. ;; Redefine dired.el
  737. (fset 'dired-add-entry 'dired-omit-new-add-entry)
  738.  
  739.  
  740. ;;
  741. (defun dired-mark-sexp (predicate &optional unflag-p)
  742.   "Mark files for which PREDICATE returns non-nil.
  743. With a prefix arg, unflag those files instead.
  744.  
  745. PREDICATE is a lisp expression that can refer to the following symbols:
  746.  
  747.     inode  [integer] the inode of the file (only for ls -i output)
  748.     s      [integer] the size of the file for ls -s output
  749.                  (ususally in blocks or, with -k, in KByte)
  750.     mode   [string]  file permission bits, e.g. \"-rw-r--r--\"
  751.     nlink  [integer] number of links to file
  752.     uid    [string]  owner
  753.     gid    [string]  group  (If the gid is not displayed by ls,
  754.                  this will still be set (to the same as uid))
  755.     size   [integer] file size in bytes
  756.     time   [string]  the time that ls displays, e.g. \"Feb 12 14:17\"
  757.     name   [string]  the name of the file
  758.     sym    [string]  if file is a symbolic link, the linked-to name, else \"\"
  759.  
  760. For example, use
  761.  
  762.         (equal 0 size)
  763.  
  764. to mark all zero length files."
  765.   ;; Using sym="" instead of nil avoids the trap of
  766.   ;; (string-match "foo" sym) into which a user would soon fall.
  767.   ;; Give `equal' instead of `=' in the example, as this works on
  768.   ;; integers and strings.
  769.   (interactive "xMark if (lisp expr): \nP")
  770.   (message "%s" predicate)
  771.   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
  772.     inode s mode nlink uid gid size time name sym)
  773.     (dired-mark-if
  774.      (save-excursion (and (dired-parse-ls)
  775.               (eval predicate)))
  776.      (format "'%s file" predicate))
  777.     ;; With Jamie's compiler we could do the following instead:
  778. ;    (eval (byte-compile-sexp
  779. ;       (macroexpand
  780. ;        (` (dired-mark-if
  781. ;        (save-excursion (and (dired-parse-ls)
  782. ;                     (, predicate)))
  783. ;        (format "'%s file" (quote (, predicate))))))))
  784.     ;; This isn't measurably faster, though, at least for simple predicates.
  785.     ;; Caching compiled predicates might be interesting if you use
  786.     ;; this command a lot or with complicated predicates.
  787.     ;; Alternatively compiling PREDICATE by hand should not be too
  788.     ;; hard - e.g., if it uses just one variable, not all of the ls
  789.     ;; line needs to be parsed.
  790.     ))
  791.  
  792. (if (fboundp 'gmhist-make-magic)
  793.     (gmhist-make-magic 'dired-mark-sexp 'eval-expression-history))
  794.  
  795. (defun dired-parse-ls ()
  796.   ;; Sets vars
  797.   ;;                inode s mode nlink uid gid size time name sym
  798.   ;; (probably let-bound in caller) according to current file line.
  799.   ;; Returns t for succes, nil if this is no file line.
  800.   ;; Upon success, all variables are set, either to nil or the
  801.   ;; appropriate value, so they need not be initialized.
  802.   ;; Moves point within the current line.
  803.   (if (dired-move-to-filename)
  804.       (let (pos
  805.         (mode-len 10)        ; length of mode string
  806.         ;; like in dired.el, but with subexpressions \1=inode, \2=s:
  807.         (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?"))
  808.     (beginning-of-line)
  809.     (forward-char 2)
  810.     (if (looking-at dired-re-inode-size)
  811.         (progn
  812.           (goto-char (match-end 0))
  813.           (setq inode (string-to-int (buffer-substring (match-beginning 1)
  814.                                (match-end 1)))
  815.             s (string-to-int (buffer-substring (match-beginning 2)
  816.                                (match-end 2)))))
  817.       (setq inode nil
  818.         s nil))
  819.     (setq mode (buffer-substring (point) (+ mode-len (point))))
  820.     (forward-char mode-len)
  821.     (setq nlink (read (current-buffer)))
  822.     (setq uid (buffer-substring (point) (progn (forward-word 1) (point))))
  823.     (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)")
  824.     (goto-char (match-beginning 1))
  825.     (forward-char -1)
  826.     (setq size (string-to-int (buffer-substring (save-excursion
  827.                               (backward-word 1)
  828.                               (setq pos (point)))
  829.                             (point))))
  830.     (goto-char pos)
  831.     (backward-word 1)
  832.     ;; if no gid is displayed, gid will be set to uid
  833.     ;; but user will then not reference it anyway in PREDICATE.
  834.     (setq gid (buffer-substring (save-excursion (forward-word 1) (point))
  835.                     (point))
  836.           time (buffer-substring (match-beginning 1)
  837.                      (1- (dired-move-to-filename)))
  838.           name (buffer-substring (point)
  839.                      (or (dired-move-to-end-of-filename t)
  840.                      (point)))
  841.           sym  (progn
  842.              (if (looking-at " -> ")
  843.              (buffer-substring (progn (forward-char 4) (point))
  844.                        (progn (end-of-line) (point)))
  845.                "")))
  846.     t)
  847.     nil))
  848.  
  849.  
  850. ;; tester
  851. ;;(defun dired-parse-ls-show ()
  852. ;;  (interactive)
  853. ;;   (let (inode s mode size uid gid nlink time name sym)
  854. ;;     (if (dired-parse-ls)
  855. ;;     (message "%s" (list inode s mode nlink uid gid size time name sym))
  856. ;;       (message "Not on a file line."))))
  857.  
  858.  
  859. ;; Mark files whose names appear in another buffer.
  860.  
  861. (defun dired-mark-these-files (file-list from)
  862.   ;; Mark the files in FILE-LIST.  Relative filenames are taken to be
  863.   ;; in the current dired directory.
  864.   ;; FROM is a string (used for logging) describing where FILE-LIST
  865.   ;; came from.
  866.   ;; Logs files that were not found and displays a success or failure
  867.   ;; message.
  868.   (message "Marking files %s..." from)
  869.   (let ((total (length file-list))
  870.     (cur-dir (dired-current-directory))
  871.     file failures)
  872.     (while file-list
  873.       (setq file (dired-make-absolute (car file-list) cur-dir)
  874.         file-list (cdr file-list))
  875.       ;;(message "Marking file `%s'" file)
  876.       (save-excursion
  877.     (if (dired-goto-file file)
  878.         (dired-mark-file 1)
  879.       (setq failures (cons (dired-make-relative file) failures))
  880.       (dired-log "Cannot mark this file (not found): %s\n" file))))
  881.     (if failures
  882.     (dired-log-summary (message "Failed to mark %d of %d files %s %s"
  883.                     (length failures) total from failures))
  884.       (message "Marked %d file%s %s." total (dired-plural-s total) from))))
  885.  
  886. (defun dired-mark-files-from-other-dired-buffer (buf)
  887.   "Mark files that are marked in the other Dired buffer.
  888. I.e, mark those files in this Dired buffer that have the same
  889. non-directory part as the marked files in the Dired buffer in the other window."
  890.   (interactive (list (window-buffer (next-window))))
  891.   (if (eq (get-buffer buf) (current-buffer))
  892.       (error "Other dired buffer is the same"))
  893.   (or (stringp buf) (setq buf (buffer-name buf)))
  894.   (let ((other-files (save-excursion
  895.                (set-buffer buf)
  896.                (or (eq major-mode 'dired-mode)
  897.                (error "%s is not a dired buffer" buf))
  898.                (dired-mark-get-files 'no-dir))))
  899.     (dired-mark-these-files other-files (concat "from buffer " buf))))
  900.  
  901. (defun dired-mark-files-compilation-buffer (&optional regexp buf)
  902.   "Mark the files mentioned in the `*compilation*' buffer.
  903. With an arg, you may specify the other buffer and your own regexp
  904. instead of `compilation-error-regexp'.
  905. Use `^.+$' (the default with a prefix arg) to match complete lines or
  906. an empty string for `compilation-error-regexp'.
  907. In conjunction with narrowing the other buffer you can mark an
  908. arbitrary list of files, one per line, with this command."
  909.   (interactive
  910.    (if current-prefix-arg
  911.        (list
  912.     (read-string "Use compilation regexp: " "^.+$")
  913.     (read-buffer "Use buffer: "
  914.              (let ((next-buffer (window-buffer (next-window))))
  915.                (if (eq next-buffer (current-buffer))
  916.                (other-buffer)
  917.              next-buffer))))))
  918.   (let (other-files user-regexp-p)
  919.     (if (zerop (length regexp))        ; nil or ""
  920.     (setq regexp compilation-error-regexp)
  921.       (setq user-regexp-p t))
  922.     (or buf (setq buf "*compilation*"))
  923.     (or (stringp buf) (setq buf (buffer-name buf)))
  924.     (save-excursion
  925.       (set-buffer (or (get-buffer buf)
  926.               (error "No %s buffer!" buf)))
  927.       (goto-char (point-min))
  928.       (let (file new-file)
  929.     (while (re-search-forward regexp nil t)
  930.       (setq new-file
  931.         (buffer-substring
  932.          ;; If user specified a regexp with subexpr 1, and it
  933.          ;; matched, take that one for the file name, else
  934.          ;; take whole match.
  935.          ;; Else take the match from the compile regexp
  936.          (if user-regexp-p
  937.              (or (match-beginning 1)
  938.              (match-beginning 0))
  939.            (match-beginning 1))
  940.          (if user-regexp-p
  941.              (or (match-end 1)
  942.              (match-end 0))
  943.            (match-beginning 2))))
  944.       (or (equal file new-file)
  945.           ;; Avoid marking files twice as this is slow.  Multiple
  946.           ;; lines for the same file are common when compiling.
  947.           (setq other-files (cons new-file other-files)
  948.             file new-file)))))
  949.     (dired-mark-these-files other-files (concat "from buffer " buf))))
  950.  
  951.  
  952. ;; make-symbolic-link always expand-file-name's its args, so relative
  953. ;; symlinks (e.g. "foo" -> "../bar/foo") are impossible to create.
  954. ;; Following code uses ln -s for a workaround.
  955.  
  956. (defvar dired-keep-marker-relsymlink ?S
  957.   "See variable `dired-keep-marker-move'.")
  958.  
  959. (defun dired-make-symbolic-link (name1 name2 &optional ok-if-already-exists)
  960.   ;; Args NAME1 NAME2 &optional OK-IF-ALREADY-EXISTS.
  961.   ;; Create file NAME2, a symbolic link pointing to NAME1 (which may
  962.   ;; be any string whatsoever and is passed untouched to ln -s).
  963.   ;; OK-IF-ALREADY-EXISTS means that NAME2 will be overwritten if it
  964.   ;; already exists.  If it is an integer, user will be asked about this.
  965.   ;; On error, signals a file-error.
  966.   (interactive "FSymlink to (string): \nFMake symbolic link to `%s': \np")
  967.   (setq name2 (expand-file-name name2))
  968.   (let* ((file-symlink-p (file-symlink-p name2))
  969.      (file-exists-p (file-exists-p name2)) ; dereferences symlinks
  970.      (file-or-symlink-exists (or file-symlink-p file-exists-p)))
  971.     (if (and file-symlink-p (not file-exists-p))
  972.     ;; We do something dirty here as dired.el never checks
  973.     ;; file-symlink-p in addition to file-exists-p.
  974.     ;; This way me make sure we never silently overwrite even
  975.     ;; symlinks to non-existing files (what an achievement! ;-)
  976.     (setq ok-if-already-exists 1))
  977.     (if (or (null ok-if-already-exists)
  978.         (integerp ok-if-already-exists))
  979.     (if (and file-or-symlink-exists
  980.          (not (and (integerp ok-if-already-exists)
  981.                (yes-or-no-p
  982.                 (format
  983.                  "File %s already exists; symlink anyway? "
  984.                  name2)))))
  985.         (signal 'file-error (cons "File already exists" name2))))
  986.     ;; Bombs if NAME1 starts with "-", but not all ln programs may
  987.     ;; understand "--"  to mean end of options...sigh
  988.     (let (err)
  989.       (if file-or-symlink-exists (delete-file name2))
  990.       (setq err (dired-check-process "SymLink" "ln" "-s" name1 name2))
  991.       (if err
  992.       (signal 'file-error (cons "ln" err))))))
  993.  
  994. (defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
  995.   "Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS
  996. Make a symbolic link (pointing to FILE1) in FILE2.
  997. The link is relative (if possible), for example
  998.  
  999.     \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
  1000.  
  1001. results in
  1002.  
  1003.     \"../../tex/bin/foo\" \"/vol/local/bin/foo\"
  1004. "
  1005.   (interactive "FRelSymLink: \nFRelSymLink %s: \np")
  1006.   (let (name1 name2 len1 len2 (index 0) sub)
  1007.     (setq file1 (expand-file-name file1)
  1008.       file2 (expand-file-name file2)
  1009.       len1 (length file1)
  1010.       len2 (length file2))
  1011.     ;; Find common initial pathname components:
  1012.     (let (next)
  1013.       (while (and (setq next (string-match "/" file1 index))
  1014.           (setq next (1+ next))
  1015.           (< next (min len1 len2))
  1016.           ;; For the comparison, both substrings must end in
  1017.           ;; `/', so NEXT is *one plus* the result of the
  1018.           ;; string-match.
  1019.           ;; E.g., consider the case of linking "/tmp/a/abc"
  1020.           ;; to "/tmp/abc" erronously giving "/tmp/a" instead
  1021.           ;; of "/tmp/" as common initial component
  1022.           (string-equal (substring file1 0 next)
  1023.                 (substring file2 0 next)))
  1024.     (setq index next))
  1025.       (setq name2 file2
  1026.         sub (substring file1 0 index)
  1027.         name1 (substring file1 index)))
  1028.     (if (string-equal sub "/")
  1029.     ;; No common initial pathname found
  1030.     (setq name1 file1)
  1031.       ;; Else they have a common parent directory
  1032.       (let ((tem (substring file2 index))
  1033.         (start 0)
  1034.         (count 0))
  1035.     ;; Count number of slashes we must compensate for ...
  1036.     (while (setq start (string-match "/" tem start))
  1037.       (setq count (1+ count)
  1038.         start (1+ start)))
  1039.     ;; ... and prepend a "../" for each slash found:
  1040.     (while (> count 0)
  1041.       (setq count (1- count)
  1042.         name1 (concat "../" name1)))))
  1043.     (dired-make-symbolic-link
  1044.      (directory-file-name name1)    ; must not link to foo/
  1045.                     ; (trailing slash!)
  1046.      name2 ok-if-already-exists)))
  1047.  
  1048. (defun dired-do-relsymlink (&optional arg)
  1049.    "Symlink all marked (or next ARG) files into a directory,
  1050. or make a symbolic link to the current file.
  1051. This creates relative symbolic links like
  1052.  
  1053.     foo -> ../bar/foo
  1054.  
  1055. not absolute ones like
  1056.  
  1057.     foo -> /ugly/path/that/may/change/any/day/bar/foo"
  1058.   (interactive "P")
  1059.   (dired-do-create-files 'relsymlink (function dired-make-relative-symlink)
  1060.                "RelSymLink" arg dired-keep-marker-relsymlink))
  1061.  
  1062. (defun dired-do-relsymlink-regexp (regexp newname &optional whole-path)
  1063.   "RelSymlink all marked files containing REGEXP to NEWNAME.
  1064. See functions `dired-rename-regexp' and `dired-do-relsymlink'
  1065.   for more info."
  1066.   (interactive (dired-mark-read-regexp "RelSymLink"))
  1067.   (dired-do-create-files-regexp
  1068.    (function dired-make-relative-symlink)
  1069.    "RelSymLink" nil regexp newname whole-path dired-keep-marker-relsymlink))
  1070.  
  1071. ;; Virtual dired mode to browse ls -lR listings
  1072. ;; sk@sun5  7-Mar-1991 16:00
  1073.  
  1074. (fset 'virtual-dired 'dired-virtual)
  1075. (defun dired-virtual (dirname &optional switches)
  1076.   "Put this buffer into Virtual Dired mode.
  1077.  
  1078. In Virtual Dired mode, all commands that do not actually consult the
  1079. filesystem will work.
  1080.  
  1081. This is useful if you want to peruse and move around in an ls -lR
  1082. output file, for example one you got from an ftp server.  With
  1083. ange-ftp, you can even dired a directory containing an ls-lR file,
  1084. visit that file and turn on virtual dired mode.  But don't try to save
  1085. this file, as dired-virtual indents the listing and thus changes the
  1086. buffer.
  1087.  
  1088. If you have save a Dired buffer in a file you can use \\[dired-virtual] to
  1089. resume it in a later session.
  1090.  
  1091. Type \\<dired-mode-map>\\[revert-buffer] in the
  1092. Virtual Dired buffer and answer `y' to convert the virtual to a real
  1093. dired buffer again.  You don't have to do this, though: you can relist
  1094. single subdirs using \\[dired-do-redisplay].
  1095. "
  1096.  
  1097.   ;; DIRNAME is the top level directory of the buffer.  It will become
  1098.   ;; its `default-directory'.  If nil, the old value of
  1099.   ;; default-directory is used.
  1100.  
  1101.   ;; Optional SWITCHES are the ls switches to use.
  1102.  
  1103.   ;; Shell wildcards will be used if there already is a `wildcard'
  1104.   ;; line in the buffer (thus it is a saved Dired buffer), but there
  1105.   ;; is no other way to get wildcards.  Insert a `wildcard' line by
  1106.   ;; hand if you want them.
  1107.  
  1108.   (interactive
  1109.    (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir))))
  1110.   (goto-char (point-min))
  1111.   (or (looking-at "  ")
  1112.       ;; if not already indented, do it now:
  1113.       (indent-region (point-min) (point-max) 2))
  1114.   (or dirname (setq dirname default-directory))
  1115.   (setq dirname (expand-file-name (file-name-as-directory dirname)))
  1116.   (setq default-directory dirname)    ; contains no wildcards
  1117.   (let ((wildcard (save-excursion
  1118.             (goto-char (point-min))
  1119.             (forward-line 1)
  1120.             (and (looking-at "^  wildcard ")
  1121.              (buffer-substring (match-end 0)
  1122.                        (progn (end-of-line) (point)))))))
  1123.   (if wildcard
  1124.     (setq dirname (expand-file-name wildcard default-directory))))
  1125.   ;; If raw ls listing (not a saved old dired buffer), give it a
  1126.   ;; decent subdir headerline:
  1127.   (goto-char (point-min))
  1128.   (or (looking-at dired-subdir-regexp)
  1129.       (dired-insert-headerline default-directory))
  1130.   (dired-mode dirname (or switches dired-listing-switches))
  1131.   (setq mode-name "Virtual Dired"
  1132.     revert-buffer-function 'dired-virtual-revert)
  1133.   (set (make-local-variable 'dired-subdir-alist) nil)
  1134.   (dired-build-subdir-alist)
  1135.   (goto-char (point-min))
  1136.   (dired-initial-position dirname))
  1137.  
  1138. (defun dired-virtual-guess-dir ()
  1139.  
  1140.   ;; Guess and return appropriate working directory of this buffer,
  1141.   ;; assumed to be in Dired or ls -lR format.
  1142.   ;; The guess is based upon buffer contents.
  1143.   ;; If nothing could be guessed, returns nil.
  1144.  
  1145.   (let ((regexp "^\\(  \\)?\\([^ \n\r]*\\)\\(:\\)[\n\r]")
  1146.     (subexpr 2))
  1147.     (goto-char (point-min))
  1148.     (cond ((looking-at regexp)
  1149.        ;; If a saved dired buffer, look to which dir and
  1150.        ;; perhaps wildcard it belongs:
  1151.        (let ((dir (buffer-substring (match-beginning subexpr)
  1152.                     (match-end subexpr))))
  1153.          (file-name-as-directory dir)))
  1154.       ;; Else no match for headerline found.  It's a raw ls listing.
  1155.       ;; In raw ls listings the directory does not have a headerline
  1156.       ;; try parent of first subdir, if any
  1157.       ((re-search-forward regexp nil t)
  1158.        (file-name-directory
  1159.         (directory-file-name
  1160.          (file-name-as-directory
  1161.           (buffer-substring (match-beginning subexpr)
  1162.                 (match-end subexpr))))))
  1163.       (t                ; if all else fails
  1164.        nil))))
  1165.  
  1166.  
  1167. (defun dired-virtual-revert (&optional arg noconfirm)
  1168.   (if (not
  1169.        (y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? "))
  1170.       (error "Cannot revert a Virtual Dired buffer.")
  1171.     (setq mode-name "Dired"
  1172.       revert-buffer-function 'dired-revert)
  1173.     (revert-buffer)))
  1174.  
  1175. ;; A zero-arg version of dired-virtual.
  1176. ;; You need my modified version of set-auto-mode for the
  1177. ;; `buffer-contents-mode-alist'.
  1178. ;; Or you use infer-mode.el and infer-mode-alist, same syntax.
  1179. (defun dired-virtual-mode ()
  1180.   "Put current buffer into virtual dired mode (see `dired-virtual').
  1181. Useful on `buffer-contents-mode-alist' (which see) with the regexp
  1182.  
  1183.     \"^  \\(/[^ /]+\\)/?+:$\"
  1184.  
  1185. to put saved dired buffers automatically into virtual dired mode.
  1186.  
  1187. Also useful for `auto-mode-alist' (which see) like this:
  1188.  
  1189.   \(setq auto-mode-alist (cons '(\"[^/]\\.dired$\" . dired-virtual-mode)
  1190.                   auto-mode-alist)\)
  1191. "
  1192.   (interactive)
  1193.   (dired-virtual (dired-virtual-guess-dir)))
  1194.  
  1195.  
  1196. (defvar dired-find-subdir nil        ; t is pretty near to DWIM...
  1197.   "*If non-nil, Dired does not make a new buffer for a directory if it
  1198. can be found (perhaps as subdir) in some existing Dired buffer.
  1199.  
  1200. If there are several Dired buffers for a directory, the most recently
  1201. used is chosen.
  1202.  
  1203. Dired avoids switching to the current buffer, so that if you have
  1204. a normal and a wildcard buffer for the same directory, C-x d RET will
  1205. toggle between those two.")
  1206.  
  1207. (or (fboundp 'dired-old-find-buffer-nocreate)
  1208.     (fset 'dired-old-find-buffer-nocreate
  1209.       (symbol-function 'dired-find-buffer-nocreate)))
  1210.  
  1211. (defun dired-find-buffer-nocreate (dirname) ; redefine dired.el
  1212.   (if dired-find-subdir
  1213.       (let* ((cur-buf (current-buffer))
  1214.          (buffers (nreverse (dired-buffers-for-dir-exact dirname)))
  1215.          (cur-buf-matches (and (memq cur-buf buffers)
  1216.                    ;; wildcards must match, too:
  1217.                    (equal dired-directory dirname))))
  1218.     ;; We don't want to switch to the same buffer---
  1219.     (setq buffers (delq cur-buf buffers));;need setq with delq
  1220.     (or (car (sort buffers (function dired-x-buffer-more-recently-used-p)))
  1221.         ;; ---unless it's the only possibility:
  1222.         (and cur-buf-matches cur-buf)))
  1223.     (dired-old-find-buffer-nocreate dirname)))
  1224.  
  1225. ;; this should be a builtin
  1226. (defun dired-x-buffer-more-recently-used-p (buffer1 buffer2)
  1227.   "Return t if BUFFER1 is more recently used than BUFFER2."
  1228.   (if (equal buffer1 buffer2)
  1229.       nil
  1230.     (let ((more-recent nil)
  1231.       (list (buffer-list)))
  1232.       (while (and list
  1233.           (not (setq more-recent (equal buffer1 (car list))))
  1234.           (not (equal buffer2 (car list))))
  1235.     (setq list (cdr list)))
  1236.       more-recent)))
  1237.  
  1238. (defun dired-buffers-for-dir-exact (dir)
  1239. ;; Return a list of buffers that dired DIR (a directory or wildcard)
  1240. ;; at top level, or as subdirectory.
  1241. ;; Top level matches must match the wildcard part too, if any.
  1242. ;; The list is in reverse order of buffer creation, most recent last.
  1243. ;; As a side effect, killed dired buffers for DIR are removed from
  1244. ;; dired-buffers.
  1245.   (let ((alist dired-buffers) result elt)
  1246.     (while alist
  1247.       (setq elt (car alist)
  1248.         alist (cdr alist))
  1249.       (let ((buf (cdr elt)))
  1250.     (if (buffer-name buf)
  1251.         ;; Top level must match exactly against dired-directory in
  1252.         ;; case one of them is a wildcard.
  1253.         (if (or (equal dir (save-excursion (set-buffer buf)
  1254.                            dired-directory))
  1255.             (assoc dir (save-excursion (set-buffer buf)
  1256.                            dired-subdir-alist)))
  1257.         (setq result (cons buf result)))
  1258.       ;; else buffer is killed - clean up:
  1259.       (setq dired-buffers (delq elt dired-buffers)))))
  1260.     result))
  1261.  
  1262. (defun dired-buffers-for-top-dir (dir)
  1263. ;; Return a list of buffers that dired DIR (a directory, not a wildcard)
  1264. ;; at top level, with or without wildcards.
  1265. ;; As a side effect, killed dired buffers for DIR are removed from
  1266. ;; dired-buffers.
  1267.   (setq dir (file-name-as-directory dir))
  1268.   (let ((alist dired-buffers) result elt)
  1269.     (while alist
  1270.       (setq elt (car alist)
  1271.         alist (cdr alist))
  1272.       (let ((buf (cdr elt)))
  1273.     (if (buffer-name buf)
  1274.         (if (equal dir (save-excursion (set-buffer buf) default-directory))
  1275.         (setq result (cons buf result)))
  1276.       ;; else buffer is killed - clean up:
  1277.       (setq dired-buffers (delq elt dired-buffers)))))
  1278.     result))
  1279.  
  1280. (defun dired-initial-position (dirname)    ; redefine dired.el
  1281.   (end-of-line)
  1282.   (if dired-find-subdir (dired-goto-subdir dirname)) ; new
  1283.   (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
  1284.  
  1285. ;;; Let `C-x f' and `C-x 4 f' know about Tree Dired's multiple directories.
  1286. ;;; As a bonus, you get filename-at-point as default with a prefix arg.
  1287.  
  1288. ;; It's easier to add to this alist than redefine function
  1289. ;; default-directory while keeping the old information.
  1290. (defconst default-directory-alist
  1291.   '((dired-mode . (if (fboundp 'dired-current-directory)
  1292.               (dired-current-directory)
  1293.             default-directory)))
  1294.   "Alist of major modes and their opinion on default-directory, as a
  1295. lisp expression to evaluate.  A resulting value of nil is ignored in
  1296. favor of default-directory.")
  1297.  
  1298. (defun default-directory ()
  1299.   "Usage like variable `default-directory', but knows about the special
  1300. cases in variable `default-directory-alist' (which see)."
  1301.   (or (eval (cdr (assq major-mode default-directory-alist)))
  1302.       default-directory))
  1303.  
  1304. (defun find-file-read-filename-at-point (prompt)
  1305.   (if (fboundp 'gmhist-read-file-name)
  1306.       (if current-prefix-arg
  1307.       (let ((fn (filename-at-point)))
  1308.         (gmhist-read-file-name
  1309.          prompt (default-directory) fn nil
  1310.          ;; the INITIAL arg is only accepted in Emacs 19 or with gmhist:
  1311.          fn))
  1312.     (gmhist-read-file-name prompt (default-directory)))
  1313.     ;; Else gmhist is not available, thus no initial input possible.
  1314.     ;; Could use filename-at-point as default and mung prompt...ugh.
  1315.     ;; Nah, get gmhist, folks!
  1316.     (read-file-name prompt (default-directory))))
  1317.  
  1318. (defun filename-at-point ()
  1319.   "Get the filename closest to point, but don't change your position.
  1320. Has a preference for looking backward when not directly on a symbol."
  1321.   ;; Not at all perfect - point must be right in the name.
  1322.   (let ((filename-chars ".a-zA-Z0-9---_/:$") start end filename
  1323.     (bol (save-excursion (beginning-of-line) (point)))
  1324.     (eol (save-excursion (end-of-line) (point))))
  1325.     (save-excursion
  1326.       ;; first see if you're just past a filename
  1327.       (if (not (eobp))
  1328.       (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
  1329.           (progn
  1330.         (skip-chars-backward " \n\t\r({[]})")
  1331.         (if (not (bobp))
  1332.             (backward-char 1)))))
  1333.       (if (string-match (concat "[" filename-chars "]")
  1334.             (char-to-string (following-char)))
  1335.       (progn
  1336.         (skip-chars-backward filename-chars)
  1337.         (setq start (point))
  1338.         (if (string-match "[/~]" (char-to-string (preceding-char)))
  1339.         (setq start (1- start)))
  1340.         (skip-chars-forward filename-chars))
  1341.     (error "No file found around point!"))
  1342.       (expand-file-name (buffer-substring start (point))))))
  1343.  
  1344. (defun find-this-file (fn)
  1345.   "Edit file FILENAME.
  1346. Switch to a buffer visiting file FILENAME, creating one if none already exists.
  1347.  
  1348. Interactively, with a prefix arg, calls `filename-at-point'.
  1349. Useful to edit the file mentioned in the buffer you are editing, or to
  1350. test if that file exists: use minibuffer completion after snatching the
  1351. name or part of it."
  1352.   (interactive (list (find-file-read-filename-at-point "Find file: ")))
  1353.   (find-file (expand-file-name fn)))
  1354.  
  1355. (defun find-this-file-other-window (fn)
  1356.   "Edit file FILENAME in other window.
  1357. Switch to a buffer visiting file FILENAME, creating one if none already exists.
  1358.  
  1359. Interactively, with a prefix arg, call `filename-at-point'.
  1360. Useful to edit the file mentioned in the buffer you are editing, or to
  1361. test if that file exists: use minibuffer completion after snatching the
  1362. name or part of it."
  1363.   (interactive (list (find-file-read-filename-at-point "Find file: ")))
  1364.   (find-file-other-window (expand-file-name fn)))
  1365.  
  1366. (defun dired-smart-shell-command (cmd &optional insert)
  1367.   "Like function `shell-command', but in the current Tree Dired directory."
  1368.   (interactive "sShell command: \nP")
  1369.   (let ((default-directory (default-directory)))
  1370.     (shell-command cmd insert)))
  1371.  
  1372. (if (fboundp 'gmhist-make-magic)
  1373.     (gmhist-make-magic 'dired-smart-shell-command 'shell-history))
  1374.  
  1375. (defun dired-smart-background-shell-command (cmd)
  1376.   "Run a shell command in the background.
  1377. Like function `background' but in the current Tree Dired directory."
  1378.   (interactive "s%% ")
  1379.   (shell-command (concat "cd " (default-directory) "; " cmd " &")))
  1380.  
  1381. (if (fboundp 'gmhist-make-magic)
  1382.     (gmhist-make-magic 'dired-smart-background-shell-command 'shell-history))
  1383.  
  1384.  
  1385. ;; Local variables for Dired buffers
  1386.  
  1387. (defvar dired-local-variables-file ".dired"
  1388.   "If non-nil, filename for local variables for Dired.
  1389. If Dired finds a file with that name in the current directory, it will
  1390. temporarily insert it into the dired buffer and run `hack-local-variables'.
  1391.  
  1392. Type \\[info] and and `g' `(emacs)File Variables' `RET' for more info on
  1393. local variables.")
  1394.  
  1395. (defun dired-hack-local-variables ()
  1396.   "Parse, and bind or evaluate as appropriate, any local variables
  1397. for current dired buffer.
  1398. See variable `dired-local-variables-file'."
  1399.   (if (and dired-local-variables-file
  1400.        (file-exists-p dired-local-variables-file))
  1401.       (let (buffer-read-only opoint )
  1402.     (save-excursion
  1403.       (goto-char (point-max))
  1404.       (setq opoint (point-marker))
  1405.       (insert "\^L\n")
  1406.       (insert-file-contents dired-local-variables-file))
  1407.     (let ((buffer-file-name dired-local-variables-file))
  1408.       (hack-local-variables))
  1409.     ;; Must delete it as (eobp) is often used as test for last
  1410.     ;; subdir in dired.el.
  1411.     (delete-region opoint (point-max))
  1412.     (set-marker opoint nil))))
  1413.  
  1414. ;; Guess what shell command to apply to a file.
  1415.  
  1416. (defvar dired-guess-have-gnutar nil
  1417.   "*If non-nil, name of the GNU tar executable (e.g. \"tar\" or \"gnutar\").
  1418. GNU tar's `z' switch is used for compressed tar files.
  1419. If you don't have GNU tar, set this to nil: a pipe using `zcat' is then used.")
  1420.  
  1421. (defvar dired-auto-shell-command-alist-default
  1422.   (list
  1423.    (list "\\.tar$" (if dired-guess-have-gnutar
  1424.             (concat dired-guess-have-gnutar " xvf")
  1425.           "tar xvf"))
  1426.    ;; regexps for compressed archives must come before the .Z rule to
  1427.    ;; be recognized:
  1428.    (list "\\.tar\\.Z$" (if dired-guess-have-gnutar
  1429.               (concat dired-guess-have-gnutar " zxvf")
  1430.             (concat "zcat * | tar xvf -")))
  1431.    '("\\.shar.Z$" "zcat * | unshar")
  1432.    '("\\.uu$" "uudecode")
  1433.    '("\\.hqx$" "mcvert")
  1434.    '("\\.sh$" "sh")            ; execute shell scripts
  1435.    '("\\.xbm$" "bitmap")        ; view X11 bitmaps
  1436.    '("\\.gp$" "gnuplot")
  1437.    '("\\.gif$" "xv")            ; view gif pictures
  1438.    '("\\.fig$" "xfig")            ; edit fig pictures
  1439.    '("\.tex$" "latex" "tex")
  1440.    '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi")
  1441.    (if (eq window-system 'x)        ; under X, offer both...
  1442.        '("\\.dvi$"  "xtex" "dvips")    ; ...preview and printing
  1443.      '("\\.dvi$" "dvips"))
  1444.    '("\\.Z$" "uncompress")
  1445.    ;; some popular archivers:
  1446.    '("\\.zoo$" "zoo x//")
  1447.    '("\\.zip$" "unzip")
  1448.    '("\\.lzh$" "lharc x")
  1449.    '("\\.arc$" "arc x")
  1450.    '("\\.shar$" "unshar")        ; use "sh" if you don't have unshar
  1451.    )
  1452.  
  1453.   "Default for variable `dired-auto-shell-command-alist' (which see).
  1454. Set this to nil to turn off shell command guessing.")
  1455.  
  1456. (defvar dired-auto-shell-command-alist nil
  1457.   "*If non-nil, an alist of file regexps and their suggested commands.
  1458. Dired shell commands will look up the name of a file in this list
  1459. and suggest the matching command as default.
  1460.  
  1461. Each element of this list looks like
  1462.  
  1463.     \(REGEXP COMMAND...\)
  1464.  
  1465. where each COMMAND can either be a string or a lisp expression that
  1466. evaluates to a string.  If several COMMANDs are given, the first one
  1467. will be the default and minibuffer completion will use the given set.
  1468.  
  1469. These rules take precedence over the predefined rules in the variable
  1470. `dired-auto-shell-command-alist-default' (to which they are prepended).
  1471.  
  1472. You can set this variable in your ~/.emacs.  For example, to add
  1473. rules for `.foo' and `.bar' files, write
  1474.  
  1475. \(setq dired-auto-shell-command-alist
  1476.       (list (list \"\\\\.foo$\" \"FOO-COMMAND\");; fixed rule
  1477.              ;; possibly more rules ...
  1478.          (list \"\\\\.bar$\";; rule with condition test
  1479.            '(if condition
  1480.              \"BAR-COMMAND-1\"
  1481.                \"BAR-COMMAND-2\")))\)
  1482. ")
  1483.  
  1484. (setq dired-auto-shell-command-alist
  1485.       (if dired-auto-shell-command-alist;; join user and default value:
  1486.       (append dired-auto-shell-command-alist
  1487.           dired-auto-shell-command-alist-default)
  1488.     ;; else just copy the default value:
  1489.     dired-auto-shell-command-alist-default))
  1490.  
  1491. (defun dired-guess-default (files)
  1492.   ;; Guess a shell command for FILES.
  1493.   ;; Returns a command or a list of commands.
  1494.   ;; You may want to redefine this to try something smarter.
  1495.   (if (or (cdr files)
  1496.       (null dired-auto-shell-command-alist))
  1497.       nil                ; If more than one file, don't guess
  1498.     (let* ((file (car files))
  1499.        (alist dired-auto-shell-command-alist)
  1500.        elt re cmds)
  1501.       (while alist
  1502.     (setq elt (car alist)
  1503.           re (car elt)
  1504.           alist (cdr alist))
  1505.     (if (string-match re file)
  1506.         (setq cmds (cdr elt)
  1507.           alist nil)))
  1508.       (cond ((not (cdr cmds)) (eval (car cmds))) ; single command
  1509.         (t (mapcar (function eval) cmds))))))
  1510.  
  1511. (defun dired-guess-shell-command (prompt files)
  1512.   ;;"Ask user with PROMPT for a shell command, guessing a default from FILES."
  1513.   (let ((default (dired-guess-default files))
  1514.     default-list old-history val (failed t))
  1515.     (if (not (featurep 'gmhist))
  1516.     (read-string prompt (if (listp default) (car default) default))
  1517.       ;; else we have gmhist
  1518.       (if (null default)
  1519.       (read-with-history-in 'dired-shell-command-history prompt)
  1520.     (or (boundp 'dired-shell-command-history)
  1521.         (setq dired-shell-command-history nil))
  1522.     (setq old-history dired-shell-command-history)
  1523.     (if (listp default)
  1524.         ;; more than one guess
  1525.         (setq default-list default
  1526.           default (car default)
  1527.           prompt (concat
  1528.               prompt
  1529.               (format "{%d guesses} " (length default-list))))
  1530.       ;; just one guess
  1531.       (setq default-list (list default)))
  1532.     (put 'dired-shell-command-history 'default default)
  1533.     ;; push guesses onto history so that they can be retrieved with M-p
  1534.     (setq dired-shell-command-history
  1535.           (append default-list dired-shell-command-history))
  1536.     ;; the unwind-protect returns VAL, and we too.
  1537.     (unwind-protect
  1538.         (progn
  1539.           (setq val (read-with-history-in
  1540.              'dired-shell-command-history prompt)
  1541.             failed nil)
  1542.           val)
  1543.       (progn
  1544.         ;; Undo pushing onto the history list so that an aborted
  1545.         ;; command doesn't get the default in the next command.
  1546.         (setq dired-shell-command-history old-history)
  1547.         (if (not failed)
  1548.         (or (equal val (car-safe dired-shell-command-history))
  1549.             (setq dired-shell-command-history
  1550.               (cons val dired-shell-command-history))))))))))
  1551.  
  1552. ;; redefine dired.el's version:
  1553. (defun dired-read-shell-command (prompt arg files)
  1554.   "Read a dired shell command using generic minibuffer history.
  1555. This command tries to guess a command from the filename(s)
  1556. from the variable `dired-auto-shell-command-alist' (which see)."
  1557.   (dired-mark-pop-up
  1558.    nil 'shell files            ; bufname type files
  1559.    'dired-guess-shell-command        ; function &rest args
  1560.    (format prompt (dired-mark-prompt arg files)) files))
  1561.  
  1562.  
  1563. ;; Byte-compile-and-load (requires jwz@lucid.com's new byte compiler)
  1564. (defun dired-do-byte-compile-and-load (&optional arg)
  1565.   "Byte compile marked and load (or next ARG) Emacs lisp files.
  1566. This requires jwz@lucid.com's new optimizing byte compiler."
  1567.   (interactive "P")
  1568.   (dired-mark-map-check (function dired-byte-compile-and-load) arg
  1569.             'byte-compile-and-load t))
  1570.  
  1571. (defun dired-byte-compile-and-load ()
  1572.   ;; Return nil for success, offending file name else.
  1573.   (let* (buffer-read-only
  1574.      (from-file (dired-get-filename))
  1575.      (new-file (byte-compile-dest-file from-file)))
  1576.     (if (not (string-match elisp-source-extention-re from-file))
  1577.     (progn
  1578.       (dired-log "Attempt to compile non-elisp file %s\n" from-file)
  1579.       ;; return a non-nil value as error indication
  1580.       (dired-make-relative from-file))
  1581.       (save-excursion;; Jamie's compiler may switch buffer
  1582.     (byte-compile-and-load-file from-file))
  1583.       (dired-remove-file new-file)
  1584.       (forward-line)            ; insert .elc after its .el file
  1585.       (dired-add-file new-file)
  1586.       nil)))
  1587.  
  1588. ;; Visit all marked files simultaneously.
  1589. ;; After an idea by wurgler@zippysun.math.uakron.edu (Tom Wurgler).
  1590.  
  1591. (defun dired-do-find-file (&optional arg)
  1592.   "Visit all marked files at once, and display them simultaneously.
  1593. See also function `simultaneous-find-file'.
  1594. If you want to keep the dired buffer displayed, type \\[split-window-vertically] first.
  1595. If you want just the marked files displayed and nothing else, type \\[delete-other-windows] first."
  1596.   (interactive "P")
  1597.   (simultaneous-find-file (dired-mark-get-files nil arg)))
  1598.  
  1599. (defun simultaneous-find-file (file-list)
  1600.   "Visit all files in FILE-LIST and display them simultaneously.
  1601.  
  1602. The current window is split across all files in FILE-LIST, as evenly
  1603. as possible.  Remaining lines go to the bottommost window.
  1604.  
  1605. The number of files that can be displayed this way is restricted by
  1606. the height of the current window and the variable `window-min-height'."
  1607.   ;; It is usually too clumsy to specify FILE-LIST interactively
  1608.   ;; unless via dired (dired-do-find-file).
  1609.   (let ((size (/ (window-height) (length file-list))))
  1610.     (or (<= window-min-height size)
  1611.     (error "Too many files to visit simultaneously"))
  1612.     (find-file (car file-list))
  1613.     (setq file-list (cdr file-list))
  1614.     (while file-list
  1615.       ;; Split off vertically a window of the desired size
  1616.       ;; The upper window will have SIZE lines.  We select the lower
  1617.       ;; (larger) window because we want to split that again.
  1618.       (select-window (split-window nil size))
  1619.       (find-file (car file-list))
  1620.       (setq file-list (cdr file-list)))))
  1621.