code.delx.au - gnu-emacs/blob - lisp/find-dired.el

   1 ;; find-dired.el --- run a `find' command and dired the output
   2
   3 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
   4 ;;      Sebastian Kremer <sk@thp.uni-koeln.de>
   5 ;; Maintainer: Roland McGrath <roland@gnu.ai.mit.edu>
   6 ;; Last-Modified: 16 Mar 1992
   7
   8 (defconst find-dired-version (substring "$Revision: 1.9 $" 11 -2)
   9   "$Id: find-dired.el,v 1.9 1991/11/11 13:24:31 sk Exp $")
  10
  11 ;;; Copyright (C) 1991 Roland McGrath
  12
  13 ;;; This program is free software; you can redistribute it and/or modify
  14 ;;; it under the terms of the GNU General Public License as published by
  15 ;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;; any later version.
  17 ;;;
  18 ;;; This program is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; A copy of the GNU General Public License can be obtained from this
  24 ;;; program's author (send electronic mail to roland@ai.mit.edu) or from
  25 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  26 ;;; 02139, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; INSTALLATION ======================================================
  31
  32 ;; To use this file, byte-compile it, install it somewhere in your
  33 ;; load-path, and put:
  34
  35 ;;   (autoload 'find-dired "find-dired" nil t)
  36 ;;   (autoload 'find-name-dired "find-dired" nil t)
  37 ;;   (autoload 'find-grep-dired "find-dired" nil t)
  38
  39 ;; in your ~/.emacs, or site-init.el, etc.
  40
  41 ;; To bind it to a key, put, e.g.:
  42 ;;
  43 ;;   (global-set-key "\C-cf" 'find-dired)
  44 ;;   (global-set-key "\C-cn" 'find-name-dired)
  45 ;;   (global-set-key "\C-cl" 'find-grep-dired)
  46 ;;
  47 ;; in your ~/.emacs.
  48
  49 ;;; Code:
  50
  51 (require 'dired)
  52 ;;;###autoload
  53 (defvar find-ls-option (if (eq system-type 'berkeley-unix) "-ls"
  54                          "-exec ls -ldi {} \\;")
  55   "*Option to `find' to produce an `ls -l'-type listing.")
  56
  57 ;;;###autoload
  58 (defvar find-grep-options (if (eq system-type 'berkeley-unix) "-s" "-l")
  59   "*Option to grep to be as silent as possible.
  60 On Berkeley systems, this is `-s', for others it seems impossible to
  61 suppress all output, so `-l' is used to print nothing more than the
  62 file name.")
  63
  64 (defvar find-args nil
  65   "Last arguments given to `find' by \\[find-dired].")
  66
  67 ;;;###autoload
  68 (defun find-dired (dir args)
  69   "Run `find' and go into dired-mode on a buffer of the output.
  70 The command run (after changing into DIR) is
  71
  72     find . \\( ARGS \\) -ls"
  73   (interactive (list (read-file-name "Run find in directory: " nil "" t)
  74                      (if (featurep 'gmhist)
  75                          (read-with-history-in 'find-args-history
  76                                                "Run find (with args): ")
  77                        (read-string "Run find (with args): " find-args))))
  78   ;; Expand DIR ("" means default-directory), and make sure it has a
  79   ;; trailing slash.
  80   (setq dir (file-name-as-directory (expand-file-name dir)))
  81   ;; Check that it's really a directory.
  82   (or (file-directory-p dir)
  83       (error "find-dired needs a directory: %s" dir))
  84   (switch-to-buffer (get-buffer-create "*Find*"))
  85   (widen)
  86   (kill-all-local-variables)
  87   (setq buffer-read-only nil)
  88   (erase-buffer)
  89   (setq default-directory dir
  90         find-args args
  91         args (concat "find . " (if (string= args "") ""
  92                                  (concat "\\( " args " \\) ")) find-ls-option))
  93   (dired-mode dir "-gils");; find(1)'s -ls corresponds to `ls -gilds'
  94                           ;; (but we don't want -d, of course)
  95   ;; Set subdir-alist so that Tree Dired will work (but STILL NOT with
  96   ;; dired-nstd.el):
  97   (set (make-local-variable 'dired-subdir-alist)
  98        (list (cons default-directory (point-marker)))) ; we are at point-min
  99   (setq buffer-read-only nil)
 100   ;; Subdir headlerline must come first because the first marker in
 101   ;; subdir-alist points there.
 102   (insert "  " dir ":\n")
 103   ;; Make second line a ``find'' line in analogy to the ``total'' or
 104   ;; ``wildcard'' line.
 105   (insert "  " args "\n")
 106   ;; Start the find process
 107   (set-process-filter (start-process-shell-command "find"
 108                                                    (current-buffer) args)
 109                       (function find-dired-filter))
 110   (set-process-sentinel (get-buffer-process (current-buffer))
 111                         (function find-dired-sentinel))
 112   (setq mode-line-process '(": %s")))
 113
 114 ;;;###autoload
 115 (defun find-name-dired (dir pattern)
 116   "Search DIR recursively for files matching the globbing pattern PATTERN,
 117 and run dired on those files.
 118 PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
 119 The command run (after changing into DIR) is
 120
 121     find . -name 'PATTERN' -ls"
 122   (interactive
 123    "DFind-name (directory): \nsFind-name (filename wildcard): ")
 124   (find-dired dir (concat "-name '" pattern "'")))
 125
 126 ;; This functionality suggested by
 127 ;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
 128 ;; Subject: find-dired, lookfor-dired
 129 ;; Date: 10 May 91 17:50:00 GMT
 130 ;; Organization: University of Waterloo
 131
 132 (fset 'lookfor-dired 'find-grep-dired)
 133 ;;;###autoload
 134 (defun find-grep-dired (dir args)
 135   "Find files in DIR containing a regexp ARG and start Dired on output.
 136 The command run (after changing into DIR) is
 137
 138     find . -exec grep -s ARG {} \\\; -ls
 139
 140 Thus ARG can also contain additional grep options."
 141   (interactive "DFind-grep (directory): \nsFind-grep (grep args): ")
 142   ;; find -exec doesn't allow shell i/o redirections in the command,
 143   ;; or we could use `grep -l >/dev/null'
 144   (find-dired dir
 145               (concat "-exec grep " find-grep-options " " args " {} \\\; ")))
 146
 147 (defun find-dired-filter (proc string)
 148   ;; Filter for \\[find-dired] processes.
 149   (dired-log "``%s''\n" string)
 150   (let ((buf (process-buffer proc)))
 151     (if (buffer-name buf)               ; not killed?
 152         (save-excursion
 153           (set-buffer buf)
 154           (save-restriction
 155             (widen)
 156             (save-excursion
 157               (let ((buffer-read-only nil)
 158                     (end (point-max)))
 159                 (goto-char end)
 160                 (insert string)
 161                 (goto-char end)
 162                 (or (looking-at "^")
 163                     (forward-line 1))
 164                 (while (looking-at "^")
 165                   (insert "  ")
 166                   (forward-line 1))
 167                 ;; Convert ` ./FILE' to ` FILE'
 168                 ;; This would lose if the current chunk of output
 169                 ;; starts or ends within the ` ./', so backup up a bit:
 170                 (goto-char (- end 3))   ; no error if < 0
 171                 (while (search-forward " ./" nil t)
 172                   (delete-region (point) (- (point) 2)))))))
 173       ;; The buffer has been killed.
 174       (delete-process proc))))
 175
 176 (defun find-dired-sentinel (proc state)
 177   ;; Sentinel for \\[find-dired] processes.
 178   (let ((buf (process-buffer proc)))
 179     (if (buffer-name buf)
 180         (save-excursion
 181           (set-buffer buf)
 182           (setq mode-line-process nil)
 183           (message "find-dired %s finished." (current-buffer))))))
 184
 185 (or (fboundp 'start-process-shell-command)
 186     ;; From version 19 subr.el.
 187     (defun start-process-shell-command (name buffer &rest args)
 188       "Start a program in a subprocess.  Return the process object for it.
 189 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
 190 NAME is name for process.  It is modified if necessary to make it unique.
 191 BUFFER is the buffer or (buffer-name) to associate with the process.
 192  Process output goes at end of that buffer, unless you specify
 193  an output stream or filter function to handle the output.
 194  BUFFER may be also nil, meaning that this process is not associated
 195  with any buffer
 196 Third arg is command name, the name of a shell command.
 197 Remaining arguments are the arguments for the command.
 198 Wildcards and redirection are handle as usual in the shell."
 199       (if (eq system-type 'vax-vms)
 200           (apply 'start-process name buffer args)
 201         (start-process name buffer shell-file-name "-c"
 202                        (concat "exec " (mapconcat 'identity args " "))))))
 203
 204 (provide 'find-dired)
 205
 206 ;;; find-dired.el ends here