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