find-dired.el 12.1 KB
Newer Older
1
;;; find-dired.el --- run a `find' command and dired the output
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1992, 1994-1995, 2000-2011 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

Karl Heuer's avatar
Karl Heuer committed
5
;; Author: Roland McGrath <roland@gnu.org>,
6
;;	   Sebastian Kremer <sk@thp.uni-koeln.de>
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: unix
Roland McGrath's avatar
Roland McGrath committed
9

Erik Naggum's avatar
Erik Naggum committed
10 11
;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Erik Naggum's avatar
Erik Naggum committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Erik Naggum's avatar
Erik Naggum committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
24

25 26
;;; Commentary:

Eric S. Raymond's avatar
Eric S. Raymond committed
27 28
;;; Code:

Jim Blandy's avatar
Jim Blandy committed
29
(require 'dired)
30

Andreas Schwab's avatar
Andreas Schwab committed
31 32 33 34 35
(defgroup find-dired nil
  "Run a `find' command and dired the output."
  :group 'dired
  :prefix "find-")

36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
;; FIXME this option does not really belong in this file, it's more general.
;; Eg cf some tests in grep.el.
(defcustom find-exec-terminator
  (if (eq 0
	  (ignore-errors
	    (process-file find-program nil nil nil
			  null-device "-exec" "echo" "{}" "+")))
      "+"
    (shell-quote-argument ";"))
  "String that terminates \"find -exec COMMAND {} \".
The value should include any needed quoting for the shell.
Common values are \"+\" and \"\\\\;\", with the former more efficient
than the latter."
  :version "24.1"
  :group 'find-dired
  :type 'string)

Richard M. Stallman's avatar
Richard M. Stallman committed
53
;; find's -ls corresponds to these switches.
54
;; Note -b, at least GNU find quotes spaces etc. in filenames
Andreas Schwab's avatar
Andreas Schwab committed
55
(defcustom find-ls-option
56 57 58 59 60 61 62 63 64 65
  (if (eq 0
	  (ignore-errors
	    (process-file find-program nil nil nil null-device "-ls")))
      (cons "-ls"
	    (if (eq system-type 'berkeley-unix)
		"-gilsb"
	      "-dilsb"))
    (cons
     (format "-exec ls -ld {} %s" find-exec-terminator)
     "-ld"))
Lute Kamstra's avatar
Lute Kamstra committed
66
  "Description of the option to `find' to produce an `ls -l'-type listing.
67 68
This is a cons of two strings (FIND-OPTION . LS-SWITCHES).  FIND-OPTION
gives the option (or options) to `find' that produce the desired output.
Andreas Schwab's avatar
Andreas Schwab committed
69
LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output."
70
  :version "24.1"	       ; add tests for -ls and -exec + support
Andreas Schwab's avatar
Andreas Schwab committed
71 72 73
  :type '(cons (string :tag "Find Option")
	       (string :tag "Ls Switches"))
  :group 'find-dired)
Jim Blandy's avatar
Jim Blandy committed
74

75 76 77 78
(defcustom find-ls-subdir-switches
  (if (string-match "-[a-z]*b" (cdr find-ls-option))
      "-alb"
    "-al")
79 80 81 82
  "`ls' switches for inserting subdirectories in `*Find*' buffers.
This should contain the \"-l\" switch.
Use the \"-F\" or \"-b\" switches if and only if you also use
them for `find-ls-option'."
83
  :version "24.1"			; add -b test
84
  :type 'string
85
  :group 'find-dired)
86

Andreas Schwab's avatar
Andreas Schwab committed
87
(defcustom find-grep-options
88
  (if (or (eq system-type 'berkeley-unix)
89
	  (string-match "solaris2\\|irix" system-configuration))
90
      "-s" "-q")
Lute Kamstra's avatar
Lute Kamstra committed
91
  "Option to grep to be as silent as possible.
92
On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
Andreas Schwab's avatar
Andreas Schwab committed
93 94 95
On other systems, the closest you can come is to use `-l'."
  :type 'string
  :group 'find-dired)
Jim Blandy's avatar
Jim Blandy committed
96

97
;; This used to be autoloaded (see bug#4387).
98
(defcustom find-name-arg
99
  (if read-file-name-completion-ignore-case
100
      "-iname"
101
    "-name")
Lute Kamstra's avatar
Lute Kamstra committed
102
  "Argument used to specify file name pattern.
103
If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that
104
find also ignores case.  Otherwise, -name is used."
105 106 107 108
  :type 'string
  :group 'find-dired
  :version "22.2")

Jim Blandy's avatar
Jim Blandy committed
109 110
(defvar find-args nil
  "Last arguments given to `find' by \\[find-dired].")
Roland McGrath's avatar
Roland McGrath committed
111

112 113 114
;; History of find-args values entered in the minibuffer.
(defvar find-args-history nil)

115 116
(defvar dired-sort-inhibit)

Roland McGrath's avatar
Roland McGrath committed
117 118
;;;###autoload
(defun find-dired (dir args)
119
  "Run `find' and go into Dired mode on a buffer of the output.
120
The command run (after changing into DIR) is essentially
Jim Blandy's avatar
Jim Blandy committed
121

Richard M. Stallman's avatar
Richard M. Stallman committed
122 123
    find . \\( ARGS \\) -ls

124 125
except that the car of the variable `find-ls-option' specifies what to
use in place of \"-ls\" as the final argument."
126
  (interactive (list (read-directory-name "Run find in directory: " nil "" t)
127 128
		     (read-string "Run find (with args): " find-args
				  '(find-args-history . 1))))
129 130 131
  (let ((dired-buffers dired-buffers))
    ;; Expand DIR ("" means default-directory), and make sure it has a
    ;; trailing slash.
132
    (setq dir (file-name-as-directory (expand-file-name dir)))
133 134 135 136
    ;; Check that it's really a directory.
    (or (file-directory-p dir)
	(error "find-dired needs a directory: %s" dir))
    (switch-to-buffer (get-buffer-create "*Find*"))
Gerd Moellmann's avatar
Gerd Moellmann committed
137 138 139 140 141 142 143 144 145 146 147 148 149 150

    ;; See if there's still a `find' running, and offer to kill
    ;; it first, if it is.
    (let ((find (get-buffer-process (current-buffer))))
      (when find
	(if (or (not (eq (process-status find) 'run))
		(yes-or-no-p "A `find' process is running; kill it? "))
	    (condition-case nil
		(progn
		  (interrupt-process find)
		  (sit-for 1)
		  (delete-process find))
	      (error nil))
	  (error "Cannot have two processes in `%s' at once" (buffer-name)))))
151

152 153 154 155 156
    (widen)
    (kill-all-local-variables)
    (setq buffer-read-only nil)
    (erase-buffer)
    (setq default-directory dir
157
	  find-args args	      ; save for next interactive call
158
	  args (concat find-program " . "
159 160
		       (if (string= args "")
			   ""
161 162 163 164 165
			 (concat
			  (shell-quote-argument "(")
			  " " args " "
			  (shell-quote-argument ")")
			  " "))
166 167 168 169
		       (if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|+\\)\\'"
					 (car find-ls-option))
			   (format "%s %s %s"
				   (match-string 1 (car find-ls-option))
170
				   (shell-quote-argument "{}")
171
				   find-exec-terminator)
172
			 (car find-ls-option))))
173 174
    ;; Start the find process.
    (shell-command (concat args "&") (current-buffer))
175 176
    ;; The next statement will bomb in classic dired (no optional arg allowed)
    (dired-mode dir (cdr find-ls-option))
177 178 179 180
    (let ((map (make-sparse-keymap)))
      (set-keymap-parent map (current-local-map))
      (define-key map "\C-c\C-k" 'kill-find)
      (use-local-map map))
181 182
    (make-local-variable 'dired-sort-inhibit)
    (setq dired-sort-inhibit t)
183 184 185
    (set (make-local-variable 'revert-buffer-function)
	 `(lambda (ignore-auto noconfirm)
	    (find-dired ,dir ,find-args)))
186 187 188 189 190 191
    ;; Set subdir-alist so that Tree Dired will work:
    (if (fboundp 'dired-simple-subdir-alist)
	;; will work even with nested dired format (dired-nstd.el,v 1.15
	;; and later)
	(dired-simple-subdir-alist)
      ;; else we have an ancient tree dired (or classic dired, where
192
      ;; this does no harm)
193 194
      (set (make-local-variable 'dired-subdir-alist)
	   (list (cons default-directory (point-min-marker)))))
195
    (set (make-local-variable 'dired-subdir-switches) find-ls-subdir-switches)
196 197 198 199 200
    (setq buffer-read-only nil)
    ;; Subdir headlerline must come first because the first marker in
    ;; subdir-alist points there.
    (insert "  " dir ":\n")
    ;; Make second line a ``find'' line in analogy to the ``total'' or
201
    ;; ``wildcard'' line.
202
    (insert "  " args "\n")
203
    (setq buffer-read-only t)
204
    (let ((proc (get-buffer-process (current-buffer))))
205 206 207 208 209
      (set-process-filter proc (function find-dired-filter))
      (set-process-sentinel proc (function find-dired-sentinel))
      ;; Initialize the process marker; it is used by the filter.
      (move-marker (process-mark proc) 1 (current-buffer)))
    (setq mode-line-process '(":%s"))))
Roland McGrath's avatar
Roland McGrath committed
210

211 212 213 214 215 216 217 218 219 220
(defun kill-find ()
  "Kill the `find' process running in the current buffer."
  (interactive)
  (let ((find (get-buffer-process (current-buffer))))
    (and find (eq (process-status find) 'run)
	 (eq (process-filter find) (function find-dired-filter))
	 (condition-case nil
	     (delete-process find)
	   (error nil)))))

Roland McGrath's avatar
Roland McGrath committed
221 222 223
;;;###autoload
(defun find-name-dired (dir pattern)
  "Search DIR recursively for files matching the globbing pattern PATTERN,
Jim Blandy's avatar
Jim Blandy committed
224 225 226 227 228 229 230
and run dired on those files.
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
The command run (after changing into DIR) is

    find . -name 'PATTERN' -ls"
  (interactive
   "DFind-name (directory): \nsFind-name (filename wildcard): ")
231
  (find-dired dir (concat find-name-arg " " (shell-quote-argument pattern))))
Roland McGrath's avatar
Roland McGrath committed
232

Jim Blandy's avatar
Jim Blandy committed
233 234 235 236 237 238
;; This functionality suggested by
;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
;; Subject: find-dired, lookfor-dired
;; Date: 10 May 91 17:50:00 GMT
;; Organization: University of Waterloo

239
(defalias 'lookfor-dired 'find-grep-dired)
Jim Blandy's avatar
Jim Blandy committed
240
;;;###autoload
241 242
(defun find-grep-dired (dir regexp)
  "Find files in DIR containing a regexp REGEXP and start Dired on output.
Jim Blandy's avatar
Jim Blandy committed
243 244
The command run (after changing into DIR) is

245 246
  find . \\( -type f -exec `grep-program' `find-grep-options' \\
    -e REGEXP {} \\; \\) -ls
Jim Blandy's avatar
Jim Blandy committed
247

248 249 250 251 252
where the car of the variable `find-ls-option' specifies what to
use in place of \"-ls\" as the final argument."
  ;; Doc used to say "Thus ARG can also contain additional grep options."
  ;; i) Presumably ARG == REGEXP?
  ;; ii) No it can't have options, since it gets shell-quoted.
253
  (interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ")
Jim Blandy's avatar
Jim Blandy committed
254 255
  ;; find -exec doesn't allow shell i/o redirections in the command,
  ;; or we could use `grep -l >/dev/null'
256 257 258
  ;; We use -type f, not ! -type d, to avoid getting screwed
  ;; by FIFOs and devices.  I'm not sure what's best to do
  ;; about symlinks, so as far as I know this is not wrong.
Jim Blandy's avatar
Jim Blandy committed
259
  (find-dired dir
260
	      (concat "-type f -exec " grep-program " " find-grep-options " -e "
261
		      (shell-quote-argument regexp)
262 263 264
		      " "
		      (shell-quote-argument "{}")
		      " "
265
		      ;; Doesn't work with "+".
266
		      (shell-quote-argument ";"))))
Jim Blandy's avatar
Jim Blandy committed
267

Roland McGrath's avatar
Roland McGrath committed
268 269
(defun find-dired-filter (proc string)
  ;; Filter for \\[find-dired] processes.
270 271
  (let ((buf (process-buffer proc))
	(inhibit-read-only t))
272 273
    (if (buffer-name buf)
	(with-current-buffer buf
274 275 276 277 278 279 280 281 282 283 284
	  (save-excursion
	    (save-restriction
	      (widen)
	      (let ((buffer-read-only nil)
		    (beg (point-max))
		    (l-opt (and (consp find-ls-option)
				(string-match "l" (cdr find-ls-option))))
		    (ls-regexp (concat "^ +[^ \t\r\n]+\\( +[^ \t\r\n]+\\) +"
				       "[^ \t\r\n]+ +[^ \t\r\n]+\\( +[0-9]+\\)")))
		(goto-char beg)
		(insert string)
285
		(goto-char beg)
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316
		(or (looking-at "^")
		    (forward-line 1))
		(while (looking-at "^")
		  (insert "  ")
		  (forward-line 1))
		;; Convert ` ./FILE' to ` FILE'
		;; This would lose if the current chunk of output
		;; starts or ends within the ` ./', so back up a bit:
		(goto-char (- beg 3))	; no error if < 0
		(while (search-forward " ./" nil t)
		  (delete-region (point) (- (point) 2)))
		;; Pad the number of links and file size.  This is a
		;; quick and dirty way of getting the columns to line up
		;; most of the time, but it's not foolproof.
		(when l-opt
		  (goto-char beg)
		  (goto-char (line-beginning-position))
		  (while (re-search-forward ls-regexp nil t)
		    (replace-match (format "%4s" (match-string 1))
				   nil nil nil 1)
		    (replace-match (format "%9s" (match-string 2))
				   nil nil nil 2)
		    (forward-line 1)))
		;; Find all the complete lines in the unprocessed
		;; output and process it to add text properties.
		(goto-char (point-max))
		(if (search-backward "\n" (process-mark proc) t)
		    (progn
		      (dired-insert-set-properties (process-mark proc)
						   (1+ (point)))
		      (move-marker (process-mark proc) (1+ (point)))))))))
Roland McGrath's avatar
Roland McGrath committed
317 318
      ;; The buffer has been killed.
      (delete-process proc))))
Roland McGrath's avatar
Roland McGrath committed
319 320 321

(defun find-dired-sentinel (proc state)
  ;; Sentinel for \\[find-dired] processes.
322 323
  (let ((buf (process-buffer proc))
	(inhibit-read-only t))
Roland McGrath's avatar
Roland McGrath committed
324
    (if (buffer-name buf)
325
	(with-current-buffer buf
326 327 328
	  (let ((buffer-read-only nil))
	    (save-excursion
	      (goto-char (point-max))
Richard M. Stallman's avatar
Richard M. Stallman committed
329
	      (insert "\n  find " state)
330 331 332 333
	      (forward-char -1)		;Back up before \n at end of STATE.
	      (insert " at " (substring (current-time-string) 0 19))
	      (forward-char 1)
	      (setq mode-line-process
334
		    (concat ":"
335 336 337 338 339
			    (symbol-name (process-status proc))))
	      ;; Since the buffer and mode line will show that the
	      ;; process is dead, we can delete it now.  Otherwise it
	      ;; will stay around until M-x list-processes.
	      (delete-process proc)
340
	      (force-mode-line-update)))
Roland McGrath's avatar
Roland McGrath committed
341
	  (message "find-dired %s finished." (current-buffer))))))
342

343

Jim Blandy's avatar
Jim Blandy committed
344 345
(provide 'find-dired)

Eric S. Raymond's avatar
Eric S. Raymond committed
346
;;; find-dired.el ends here