1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
;;; find-dired.el --- run a `find' command and dired the output
;; Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.ai.mit.edu>,
;; Sebastian Kremer <sk@thp.uni-koeln.de>
;; Keywords: unix
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 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
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Code:
(require 'dired)
;; find's -ls corresponds to these switches.
;; Note -b, at least GNU find quotes spaces etc. in filenames
;;;###autoload
(defvar find-ls-option (if (eq system-type 'berkeley-unix) '("-ls" . "-gilsb")
'("-exec ls -ld {} \\;" . "-ld"))
"*Description of the option to `find' to produce an `ls -l'-type listing.
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.
LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output.")
;;;###autoload
(defvar find-grep-options
(if (or (eq system-type 'berkeley-unix)
(string-match "solaris2" system-configuration)
(string-match "irix" system-configuration))
"-s" "-q")
"*Option to grep to be as silent as possible.
On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
On other systems, the closest you can come is to use `-l'.")
(defvar find-args nil
"Last arguments given to `find' by \\[find-dired].")
;; History of find-args values entered in the minibuffer.
(defvar find-args-history nil)
;;;###autoload
(defun find-dired (dir args)
"Run `find' and go into dired-mode on a buffer of the output.
The command run (after changing into DIR) is
find . \\( ARGS \\) -ls
except that the variable `find-ls-option' specifies what to use
as the final argument."
(interactive (list (read-file-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
'(find-args-history . 1))))
;; Expand DIR ("" means default-directory), and make sure it has a
;; trailing slash.
(setq dir (file-name-as-directory (expand-file-name dir)))
;; 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*"))
(widen)
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
(setq default-directory dir
find-args args ; save for next interactive call
args (concat "find . "
(if (string= args "")
""
(concat "\\( " args " \\) "))
(car find-ls-option)))
;; The next statement will bomb in classic dired (no optional arg allowed)
(dired-mode dir (cdr find-ls-option))
;; This really should rerun the find command, but I don't
;; have time for that.
(use-local-map (append (make-sparse-keymap) (current-local-map)))
(define-key (current-local-map) "g" 'undefined)
;; 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
;; this does no harm)
(set (make-local-variable 'dired-subdir-alist)
(list (cons default-directory (point-min-marker)))))
(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
;; ``wildcard'' line.
(insert " " args "\n")
;; Start the find process.
(let ((proc (start-process-shell-command "find" (current-buffer) args)))
(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")))
;;;###autoload
(defun find-name-dired (dir pattern)
"Search DIR recursively for files matching the globbing pattern PATTERN,
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): ")
(find-dired dir (concat "-name '" pattern "'")))
;; 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
(defalias 'lookfor-dired 'find-grep-dired)
;;;###autoload
(defun find-grep-dired (dir args)
"Find files in DIR containing a regexp ARG and start Dired on output.
The command run (after changing into DIR) is
find . -exec grep -s ARG {} \\\; -ls
Thus ARG can also contain additional grep options."
(interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ")
;; find -exec doesn't allow shell i/o redirections in the command,
;; or we could use `grep -l >/dev/null'
;; 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.
(find-dired dir
(concat "-type f -exec grep " find-grep-options " "
args " {} \\\; ")))
(defun find-dired-filter (proc string)
;; Filter for \\[find-dired] processes.
(let ((buf (process-buffer proc)))
(if (buffer-name buf) ; not killed?
(save-excursion
(set-buffer buf)
(save-restriction
(widen)
(save-excursion
(let ((buffer-read-only nil)
(end (point-max)))
(goto-char end)
(insert string)
(goto-char end)
(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 (- end 3)) ; no error if < 0
(while (search-forward " ./" nil t)
(delete-region (point) (- (point) 2)))
;; Find all the complete lines in the unprocessed
;; output and process it to add text properties.
(goto-char end)
(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)))))
))))
;; The buffer has been killed.
(delete-process proc))))
(defun find-dired-sentinel (proc state)
;; Sentinel for \\[find-dired] processes.
(let ((buf (process-buffer proc)))
(if (buffer-name buf)
(save-excursion
(set-buffer buf)
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(insert "\nfind " state)
(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
(concat ":"
(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)
(force-mode-line-update)))
(message "find-dired %s finished." (current-buffer))))))
(provide 'find-dired)
;;; find-dired.el ends here
|
