1;;; find-dired.el --- run a `find' command and dired the output
2
3;; Copyright (C) 1992, 1994, 1995, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Roland McGrath <roland@gnu.org>,
7;;	   Sebastian Kremer <sk@thp.uni-koeln.de>
8;; Maintainer: FSF
9;; Keywords: unix
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;;; Code:
31
32(require 'dired)
33
34(defgroup find-dired nil
35  "Run a `find' command and dired the output."
36  :group 'dired
37  :prefix "find-")
38
39(defcustom find-dired-find-program "find"
40  "Program used to find files."
41  :group 'dired
42  :type 'file)
43
44;; find's -ls corresponds to these switches.
45;; Note -b, at least GNU find quotes spaces etc. in filenames
46;;;###autoload
47(defcustom find-ls-option
48  (if (eq system-type 'berkeley-unix) '("-ls" . "-gilsb")
49    '("-exec ls -ld {} \\;" . "-ld"))
50  "*Description of the option to `find' to produce an `ls -l'-type listing.
51This is a cons of two strings (FIND-OPTION . LS-SWITCHES).  FIND-OPTION
52gives the option (or options) to `find' that produce the desired output.
53LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output."
54  :type '(cons (string :tag "Find Option")
55	       (string :tag "Ls Switches"))
56  :group 'find-dired)
57
58;;;###autoload
59(defcustom find-ls-subdir-switches "-al"
60  "`ls' switches for inserting subdirectories in `*Find*' buffers.
61This should contain the \"-l\" switch.
62Use the \"-F\" or \"-b\" switches if and only if you also use
63them for `find-ls-option'."
64  :type 'string
65  :group 'find-dired
66  :version "22.1")
67
68;;;###autoload
69(defcustom find-grep-options
70  (if (or (eq system-type 'berkeley-unix)
71	  (string-match "solaris2" system-configuration)
72	  (string-match "irix" system-configuration))
73      "-s" "-q")
74  "*Option to grep to be as silent as possible.
75On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
76On other systems, the closest you can come is to use `-l'."
77  :type 'string
78  :group 'find-dired)
79
80(defvar find-args nil
81  "Last arguments given to `find' by \\[find-dired].")
82
83;; History of find-args values entered in the minibuffer.
84(defvar find-args-history nil)
85
86(defvar dired-sort-inhibit)
87
88;;;###autoload
89(defun find-dired (dir args)
90  "Run `find' and go into Dired mode on a buffer of the output.
91The command run (after changing into DIR) is
92
93    find . \\( ARGS \\) -ls
94
95except that the variable `find-ls-option' specifies what to use
96as the final argument."
97  (interactive (list (read-file-name "Run find in directory: " nil "" t)
98		     (read-string "Run find (with args): " find-args
99				  '(find-args-history . 1))))
100  (let ((dired-buffers dired-buffers))
101    ;; Expand DIR ("" means default-directory), and make sure it has a
102    ;; trailing slash.
103    (setq dir (file-name-as-directory (expand-file-name dir)))
104    ;; Check that it's really a directory.
105    (or (file-directory-p dir)
106	(error "find-dired needs a directory: %s" dir))
107    (switch-to-buffer (get-buffer-create "*Find*"))
108
109    ;; See if there's still a `find' running, and offer to kill
110    ;; it first, if it is.
111    (let ((find (get-buffer-process (current-buffer))))
112      (when find
113	(if (or (not (eq (process-status find) 'run))
114		(yes-or-no-p "A `find' process is running; kill it? "))
115	    (condition-case nil
116		(progn
117		  (interrupt-process find)
118		  (sit-for 1)
119		  (delete-process find))
120	      (error nil))
121	  (error "Cannot have two processes in `%s' at once" (buffer-name)))))
122
123    (widen)
124    (kill-all-local-variables)
125    (setq buffer-read-only nil)
126    (erase-buffer)
127    (setq default-directory dir
128	  find-args args	      ; save for next interactive call
129	  args (concat find-dired-find-program " . "
130		       (if (string= args "")
131			   ""
132			 (concat
133			  (shell-quote-argument "(")
134			  " " args " "
135			  (shell-quote-argument ")")
136			  " "))
137		       (if (equal (car find-ls-option) "-exec ls -ld {} \\;")
138			   (concat "-exec ls -ld "
139				   (shell-quote-argument "{}")
140				   " "
141				   (shell-quote-argument ";"))
142			 (car find-ls-option))))
143    ;; Start the find process.
144    (shell-command (concat args "&") (current-buffer))
145    ;; The next statement will bomb in classic dired (no optional arg allowed)
146    (dired-mode dir (cdr find-ls-option))
147    (let ((map (make-sparse-keymap)))
148      (set-keymap-parent map (current-local-map))
149      (define-key map "\C-c\C-k" 'kill-find)
150      (use-local-map map))
151    (make-local-variable 'dired-sort-inhibit)
152    (setq dired-sort-inhibit t)
153    (set (make-local-variable 'revert-buffer-function)
154	 `(lambda (ignore-auto noconfirm)
155	    (find-dired ,dir ,find-args)))
156    ;; Set subdir-alist so that Tree Dired will work:
157    (if (fboundp 'dired-simple-subdir-alist)
158	;; will work even with nested dired format (dired-nstd.el,v 1.15
159	;; and later)
160	(dired-simple-subdir-alist)
161      ;; else we have an ancient tree dired (or classic dired, where
162      ;; this does no harm)
163      (set (make-local-variable 'dired-subdir-alist)
164	   (list (cons default-directory (point-min-marker)))))
165    (set (make-local-variable 'dired-subdir-switches) find-ls-subdir-switches)
166    (setq buffer-read-only nil)
167    ;; Subdir headlerline must come first because the first marker in
168    ;; subdir-alist points there.
169    (insert "  " dir ":\n")
170    ;; Make second line a ``find'' line in analogy to the ``total'' or
171    ;; ``wildcard'' line.
172    (insert "  " args "\n")
173    (setq buffer-read-only t)
174    (let ((proc (get-buffer-process (current-buffer))))
175      (set-process-filter proc (function find-dired-filter))
176      (set-process-sentinel proc (function find-dired-sentinel))
177      ;; Initialize the process marker; it is used by the filter.
178      (move-marker (process-mark proc) 1 (current-buffer)))
179    (setq mode-line-process '(":%s"))))
180
181(defun kill-find ()
182  "Kill the `find' process running in the current buffer."
183  (interactive)
184  (let ((find (get-buffer-process (current-buffer))))
185    (and find (eq (process-status find) 'run)
186	 (eq (process-filter find) (function find-dired-filter))
187	 (condition-case nil
188	     (delete-process find)
189	   (error nil)))))
190
191;;;###autoload
192(defun find-name-dired (dir pattern)
193  "Search DIR recursively for files matching the globbing pattern PATTERN,
194and run dired on those files.
195PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
196The command run (after changing into DIR) is
197
198    find . -name 'PATTERN' -ls"
199  (interactive
200   "DFind-name (directory): \nsFind-name (filename wildcard): ")
201  (find-dired dir (concat "-name " (shell-quote-argument pattern))))
202
203;; This functionality suggested by
204;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
205;; Subject: find-dired, lookfor-dired
206;; Date: 10 May 91 17:50:00 GMT
207;; Organization: University of Waterloo
208
209(defalias 'lookfor-dired 'find-grep-dired)
210;;;###autoload
211(defun find-grep-dired (dir regexp)
212  "Find files in DIR containing a regexp REGEXP and start Dired on output.
213The command run (after changing into DIR) is
214
215    find . -exec grep -s -e REGEXP {} \\\; -ls
216
217Thus ARG can also contain additional grep options."
218  (interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ")
219  ;; find -exec doesn't allow shell i/o redirections in the command,
220  ;; or we could use `grep -l >/dev/null'
221  ;; We use -type f, not ! -type d, to avoid getting screwed
222  ;; by FIFOs and devices.  I'm not sure what's best to do
223  ;; about symlinks, so as far as I know this is not wrong.
224  (find-dired dir
225	      (concat "-type f -exec grep " find-grep-options " -e "
226		      (shell-quote-argument regexp)
227		      " "
228		      (shell-quote-argument "{}")
229		      " "
230		      (shell-quote-argument ";"))))
231
232(defun find-dired-filter (proc string)
233  ;; Filter for \\[find-dired] processes.
234  (let ((buf (process-buffer proc))
235	(inhibit-read-only t))
236    (if (buffer-name buf)		; not killed?
237	(save-excursion
238	  (set-buffer buf)
239	  (save-restriction
240	    (widen)
241	    (save-excursion
242	      (let ((buffer-read-only nil)
243		    (end (point-max)))
244		(goto-char end)
245		(insert string)
246		(goto-char end)
247		(or (looking-at "^")
248		    (forward-line 1))
249		(while (looking-at "^")
250		  (insert "  ")
251		  (forward-line 1))
252		;; Convert ` ./FILE' to ` FILE'
253		;; This would lose if the current chunk of output
254		;; starts or ends within the ` ./', so back up a bit:
255		(goto-char (- end 3))	; no error if < 0
256		(while (search-forward " ./" nil t)
257		  (delete-region (point) (- (point) 2)))
258		;; Find all the complete lines in the unprocessed
259		;; output and process it to add text properties.
260		(goto-char (point-max))
261		(if (search-backward "\n" (process-mark proc) t)
262		    (progn
263		      (dired-insert-set-properties (process-mark proc)
264						   (1+ (point)))
265		      (move-marker (process-mark proc) (1+ (point)))))
266		))))
267      ;; The buffer has been killed.
268      (delete-process proc))))
269
270(defun find-dired-sentinel (proc state)
271  ;; Sentinel for \\[find-dired] processes.
272  (let ((buf (process-buffer proc))
273	(inhibit-read-only t))
274    (if (buffer-name buf)
275	(save-excursion
276	  (set-buffer buf)
277	  (let ((buffer-read-only nil))
278	    (save-excursion
279	      (goto-char (point-max))
280	      (insert "\n  find " state)
281	      (forward-char -1)		;Back up before \n at end of STATE.
282	      (insert " at " (substring (current-time-string) 0 19))
283	      (forward-char 1)
284	      (setq mode-line-process
285		    (concat ":"
286			    (symbol-name (process-status proc))))
287	      ;; Since the buffer and mode line will show that the
288	      ;; process is dead, we can delete it now.  Otherwise it
289	      ;; will stay around until M-x list-processes.
290	      (delete-process proc)
291	      (force-mode-line-update)))
292	  (message "find-dired %s finished." (current-buffer))))))
293
294
295(provide 'find-dired)
296
297;;; arch-tag: 8edece95-af00-4221-bc74-a4bd2f75f9b0
298;;; find-dired.el ends here
299