Mercurial > hg > xemacs-beta

comparison lisp/efs/dired-grep.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 7e54bd776075 9f59509498e1
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: dired-grep.el
5 ;; RCS:
6 ;; Dired Version: $Revision: 1.1 $
7 ;; Description: Support for running grep on marked files in a dired buffer.
8 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
9 ;; Created: Tue Jul 13 22:59:37 1993 by sandy on ibm550
10 ;;
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
13 ;;; Copyright (C) 1993 Sandy Rutherford
14
15 ;;; This program is free software; you can redistribute it and/or modify
16 ;;; it under the terms of the GNU General Public License as published by
17 ;;; the Free Software Foundation; either version 1, or (at your option)
18 ;;; any later version.
19 ;;;
20 ;;; This program is distributed in the hope that it will be useful,
21 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;;; GNU General Public License for more details.
24 ;;;
25 ;;; A copy of the GNU General Public License can be obtained from this
26 ;;; program's author (send electronic mail to sandy@ibm550.sissa.it) or
27 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
28 ;;; MA 02139, USA.
29
30 ;;; The user-level command in this file is dired-grep-file. The command
31 ;;; grep is defined in compile.el. This file does not change that command.
32
33 ;;; Requirements and provisions
34
35 (provide 'dired-grep)
36 (or (fboundp 'file-local-copy) (require 'emacs-19))
37 (or (fboundp 'generate-new-buffer) (require 'emacs-19))
38 (require 'dired)
39
40 ;;; Variables
41
42 (defvar dired-grep-program "grep"
43 "Name of program to use to grep files.
44 When used with the \"-n\" flag, program must precede each match with \"###:\",
45 where \"###\" is the line number of the match.
46 If there are grep programs which don't do this, we'll try to think of
47 some way to accomodate them.")
48
49 (defvar dired-grep-switches nil
50 "*Switches to pass to the grep program.
51 This may be either a string or a list of strings. It is not necessary to
52 include \"-n\" as that switch is always used.")
53
54 (defvar dired-grep-zcat-program "zcat"
55 "Name of program to cat compressed files.")
56
57 (defvar dired-grep-compressed-file ".\\.\\(gz\\|[zZ]\\)$"
58 "Regexp to match names of compressed files.")
59
60 (defvar dired-grep-pop-up-buffer t
61 "*If non-nil, the grep output is displayed in the other window upon
62 completion of the grep process.")
63
64 (defvar dired-grep-results-buffer "*Dired Grep*"
65 "Name of buffer where grep results are logged.")
66
67 (defvar dired-grep-mode-hook nil
68 "Hook run after going into grep-mode")
69
70 (defvar grep-history nil
71 "History of previous grep patterns used.")
72
73 (defvar dired-grep-parse-flags-cache nil)
74 (defvar dired-grep-parse-flags-cache-result nil)
75
76 (defvar dired-grep-mode-map nil
77 "Keymap for dired-grep-mode buffers.")
78
79 (if dired-grep-mode-map
80 ()
81 (setq dired-grep-mode-map (make-keymap))
82 (suppress-keymap dired-grep-mode-map)
83 (define-key dired-grep-mode-map "[" 'backward-page)
84 (define-key dired-grep-mode-map "]" 'forward-page)
85 (define-key dired-grep-mode-map ">" 'dired-grep-next-hit)
86 (define-key dired-grep-mode-map "<" 'dired-grep-previous-hit)
87 (define-key dired-grep-mode-map "n" 'dired-grep-advertized-next-hit)
88 (define-key dired-grep-mode-map "p" 'dired-grep-advertized-previous-hit)
89 (define-key dired-grep-mode-map "k" 'dired-grep-delete-line)
90 (define-key dired-grep-mode-map "d" 'dired-grep-delete-page)
91 (define-key dired-grep-mode-map "^" 'dired-grep-delete-preceding-pages)
92 (define-key dired-grep-mode-map "f" 'dired-grep-find-file)
93 (define-key dired-grep-mode-map "e" 'dired-grep-find-file)
94 (define-key dired-grep-mode-map "m" 'dired-grep-delete-misses)
95 (define-key dired-grep-mode-map "o" 'dired-grep-find-file-other-window)
96 (define-key dired-grep-mode-map "v" 'dired-grep-view-file)
97 (define-key dired-grep-mode-map "w" 'dired-grep-delete-grep-for)
98 (define-key dired-grep-mode-map "\C-_" 'dired-grep-undo)
99 (define-key dired-grep-mode-map "\C-xu" 'dired-grep-undo))
100
101 ;;; Entry functions from dired.el
102
103 (defun dired-grep (pattern flags)
104 ;; grep the file on the current line for PATTERN, using grep flags FLAGS.
105 ;; Return nil on success. Offending filename otherwise.
106 (let* ((file (dired-get-filename))
107 (result (dired-grep-file pattern file flags)))
108 (and result
109 (progn
110 (dired-log (buffer-name (current-buffer)) (concat result "\n"))
111 file))))
112
113 (defun dired-do-grep (pattern &optional flags arg)
114 "Grep marked files for a pattern. With a \C-u prefix prompts for grep flags."
115 (interactive
116 (let* ((switches (if (consp current-prefix-arg)
117 (read-string "Switches for grep: ")
118 dired-grep-switches))
119 (prompt (format "grep %sfor pattern"
120 (if (stringp switches)
121 (if (string-equal switches "")
122 switches
123 (concat switches " "))
124 (if switches
125 (concat (mapconcat 'identity switches " ") " ")
126 ""))))
127 (pattern (dired-read-with-history (concat prompt ": ")
128 nil 'grep-history)))
129 (list pattern switches
130 (and (not (consp current-prefix-arg)) current-prefix-arg))))
131 (dired-map-over-marks-check
132 (function
133 (lambda ()
134 (dired-grep pattern flags)))
135 arg 'grep (concat "grep " flags (if flags " \"" "\"") pattern "\"") t))
136
137 ;;; Utility functions
138
139 (defun dired-grep-get-results-buffer ()
140 ;; Return the buffer object of the dired-grep-results-buffer, creating and
141 ;; initializing it if necessary.
142 (let ((buffer (get-buffer dired-grep-results-buffer)))
143 (or buffer
144 (save-excursion
145 (set-buffer (setq buffer (get-buffer-create dired-grep-results-buffer)))
146 (dired-grep-mode)
147 buffer))))
148
149 ;; Only define if undefined, in case efs has got to it already.
150 (or (fboundp 'dired-grep-delete-local-temp-file)
151 (defun dired-grep-delete-local-temp-file (file)
152 (condition-case nil (delete-file file) (error nil))))
153
154 ;;; Commands in the dired-grep-results-buffer buffer.
155
156 (defun dired-grep-mode ()
157 "\\<dired-grep-mode-map>Mode for perusing grep output generated from dired.
158 The output is divided into pages, one page per grepped file.
159
160 Summary of commands:
161
162 Move to next grep hit \\[dired-grep-advertized-next-hit], \\[dired-grep-next-hit]
163 Move to previous grep hit \\[dired-grep-advertized-previous-hit], \\[dired-grep-previous-hit]
164 Move to output for next file \\[forward-page]
165 Move to output for previous file \\[backward-page]
166
167 Delete the current grep line \\[dired-grep-delete-line]
168 Delete all output for current file \\[dired-grep-delete-page]
169 Delete all preceding pages \\[dired-grep-delete-preceding-pages]
170 Delete all pages for files with no hits \\[dired-grep-delete-misses]
171 Delete all pages which grep for the
172 same pattern as the current page \\[dired-grep-delete-grep-for]
173
174 Find current grep hit in file \\[dired-grep-find-file]
175 Find current grep hit in other window \\[dired-grep-find-file-other-window]
176 View current grep hit \\[dired-grep-view-file]
177
178 Undo changes to the grep buffer \\[dired-grep-undo]
179
180 Keybindings:
181 \\{dired-grep-mode-map}"
182 (kill-all-local-variables)
183 (use-local-map dired-grep-mode-map)
184 (setq major-mode 'dired-grep-mode
185 mode-name "Dired-Grep"
186 buffer-read-only t)
187 (set (make-local-variable 'page-delimiter) "\n\n")
188 (run-hooks 'dired-grep-mode-hook))
189
190 (defun dired-grep-current-file-and-line ()
191 ;; Returns a list \(FILENAME . LINE\) corresponding to the filename
192 ;; and line number associated with the position of the point in a
193 ;; grep buffer. Returns nil if there is none.
194 (save-excursion
195 (let (file line)
196 (and
197 (progn
198 (beginning-of-line)
199 (looking-at "[0-9]+:"))
200 (progn
201 (setq line (string-to-int (buffer-substring (point)
202 (1- (match-end 0)))))
203 (if (search-backward "\n\n" nil 'move) (forward-char 2))
204 (looking-at "Hits for "))
205 (progn
206 (forward-line 1)
207 (looking-at " "))
208 (progn
209 (setq file (buffer-substring (match-end 0)
210 (progn (end-of-line) (1- (point)))))
211 (cons file line))))))
212
213 (defun dired-grep-find-file ()
214 (interactive)
215 (let ((file (dired-grep-current-file-and-line)))
216 (if file
217 (progn
218 (find-file (car file))
219 (goto-line (cdr file))
220 (recenter '(4)))
221 (error "No file specified by this line."))))
222
223 (defun dired-grep-find-file-other-window ()
224 (interactive)
225 (let ((file (dired-grep-current-file-and-line)))
226 (if file
227 (progn
228 (find-file-other-window (car file))
229 (goto-line (cdr file))
230 (recenter '(4)))
231 (error "No file specified by this line."))))
232
233 (defun dired-grep-view-file ()
234 (interactive)
235 (let ((file (dired-grep-current-file-and-line)))
236 (if file
237 (let* ((fun (function
238 (lambda () (goto-line (cdr file)) (recenter '(4)))))
239 (view-hook
240 (if (boundp 'view-hook)
241 (if (and (listp view-hook)
242 (not (eq (car view-hook) 'lambda)))
243 (cons fun view-hook)
244 (list fun view-hook))
245 fun)))
246 (view-file (car file)))
247 (error "No file specified by this line."))))
248
249 (defun dired-grep-next-hit (arg)
250 "Moves to the next, or next ARGth, grep hit."
251 (interactive "p")
252 (forward-line 1)
253 (if (re-search-forward "^[0-9]" nil 'move arg)
254 (goto-char (match-beginning 0))
255 (error "No further grep hits")))
256
257 (defun dired-grep-previous-hit (arg)
258 "Moves to the previous, or previous ARGth, grep hit."
259 (interactive "p")
260 (beginning-of-line)
261 (or (re-search-backward "^[0-9]" nil 'move arg)
262 (error "No further grep hits")))
263
264 ;; These are only so we can get a decent looking help buffer.
265 (fset 'dired-grep-advertized-next-hit 'dired-grep-next-hit)
266 (fset 'dired-grep-advertized-previous-hit 'dired-grep-previous-hit)
267
268 (defun dired-grep-delete-page (arg)
269 "Deletes the current and ARG - 1 following grep output pages.
270 If ARG is negative, deletes preceding pages."
271 (interactive "p")
272 (let ((done 0)
273 (buffer-read-only nil)
274 (backward (< arg 0))
275 start)
276 (if backward (setq arg (- arg)))
277 (while (and (< done arg) (not (if backward (bobp) (eobp))))
278 (or (looking-at "^\n")
279 (if (search-backward "\n\n" nil 'move) (forward-char 1)))
280 (setq start (point))
281 (if (search-forward "\n\n" nil 'move) (forward-char -1))
282 (delete-region start (point))
283 (and (bobp) (not (eobp)) (delete-char 1))
284 (if backward (skip-chars-backward "\n"))
285 (setq done (1+ done)))))
286
287 (defun dired-grep-delete-preceding-pages ()
288 "Deletes the current, and all preceding pages from the grep buffer."
289 (interactive)
290 (let ((buffer-read-only nil))
291 (if (looking-at "^\n")
292 (forward-char 1)
293 (search-forward "\n\n" nil 'move))
294 (delete-region (point-min) (point))))
295
296 (defun dired-grep-delete-line (arg)
297 "Deletes the current line and ARG following lines from the grep buffer.
298 Only operates on lines which correspond to file lines for grep hits."
299 (interactive "p")
300 (let ((opoint (point))
301 (buffer-read-only nil)
302 (backward (< arg 0))
303 (done 0))
304 (beginning-of-line)
305 (if backward (setq arg (- arg)))
306 (if (looking-at "[0-9]+:")
307 (while (< done arg)
308 (delete-region (point) (progn (forward-line 1) (point)))
309 (if backward (forward-line -1))
310 (if (looking-at "[0-9]+:")
311 (setq done (1+ done))
312 (setq done arg)))
313 ;; Do nothing.
314 (goto-char opoint))))
315
316 (defun dired-grep-delete-grep-for ()
317 "Deletes all pages which grep some file for the pattern of the current page."
318 (interactive)
319 (save-excursion
320 ;; In case we happen to be right at the beginning of a page.
321 (or (eobp) (eolp) (forward-char 1))
322 (forward-page -1) ; gets to the beginning of the page.
323 (let* ((eol (save-excursion (end-of-line) (point)))
324 (line (and (search-forward " grep " eol t)
325 (buffer-substring (point) eol))))
326 (if line
327 (progn
328 (goto-char (point-min))
329 (while (not (eobp))
330 (let* ((eol (save-excursion (end-of-line) (point)))
331 (this-line (and (search-forward " grep " eol t)
332 (buffer-substring (point) eol))))
333 (if (equal line this-line)
334 (progn
335 (dired-grep-delete-page 1)
336 (skip-chars-forward "\n"))
337 (or (eobp) (forward-page 1))))))))))
338
339 (defun dired-grep-delete-misses ()
340 "Delete all pages for which there were no grep hits.
341 Deletes pages for which grep failed because of an error too."
342 (interactive)
343 (save-excursion
344 (goto-char (point-min))
345 (while (not (eobp))
346 (if (looking-at "Grep failed \\|No hits ")
347 (progn
348 (dired-grep-delete-page 1)
349 (skip-chars-forward "\n"))
350 (forward-page 1)))))
351
352 (defun dired-grep-undo ()
353 "Undoes deletions in a grep buffer."
354 (interactive)
355 (let (buffer-read-only)
356 (undo)))
357
358 ;;; Commands for grepping files.
359
360 (defun dired-grep-parse-flags (string)
361 ;; Breaks a string of switches into a list.
362 (if (equal dired-grep-parse-flags-cache string)
363 dired-grep-parse-flags-cache-result
364 (let ((length (length string))
365 (pointer 0)
366 (start 0)
367 (result nil))
368 (while (and (< pointer length) (= (aref string pointer) ?\ ))
369 (setq pointer (1+ pointer)))
370 (while (< pointer length)
371 (setq start pointer)
372 (while (and (< pointer length) (/= (aref string pointer) ?\ ))
373 (setq pointer (1+ pointer)))
374 (setq result (cons (substring string start pointer) result))
375 (while (and (< pointer length) (= (aref string pointer) ?\ ))
376 (setq pointer (1+ pointer))))
377 (setq dired-grep-parse-flags-cache string
378 dired-grep-parse-flags-cache-result (nreverse result)))))
379
380 (defun dired-grep-file (pattern file &optional flags)
381 "Grep for PATTERN in FILE.
382 Optional FLAGS are flags to pass to the grep program.
383 When used interactively, will prompt for FLAGS if a prefix argument is used."
384 (interactive
385 (let* ((switches (if (consp current-prefix-arg)
386 (read-string "Switches for grep: ")
387 dired-grep-switches))
388 (prompt (format "grep %sfor pattern"
389 (if (stringp switches)
390 (if (string-match switches "^ *$")
391 ""
392 (concat switches " "))
393 (if switches
394 (concat (mapconcat 'identity switches " ") " ")
395 ""))))
396 (pattern (dired-read-with-history (concat prompt ": ")
397 nil 'grep-history))
398 (file (read-file-name (concat prompt " \"" pattern "\" in file :"))))
399 (list pattern file switches)))
400 (setq file (expand-file-name file))
401 (if (listp flags)
402 (setq flags (mapconcat 'identity flags " "))
403 (if (string-match "^ +$" flags)
404 (setq flags "")))
405 (let ((file-buff (get-file-buffer file)))
406 (if (and file-buff (buffer-modified-p file-buff))
407 (if (y-or-n-p (format "Save buffer %s? " (buffer-name file-buff)))
408 (save-excursion
409 (set-buffer file-buff)
410 (save-buffer)))))
411 (let ((buffer (dired-grep-get-results-buffer))
412 (compressed (string-match dired-grep-compressed-file file))
413 failed temp-file jka-compr-compression-info-list)
414 (setq temp-file
415 (condition-case err
416 (file-local-copy file)
417 (error (progn (setq failed (format "%s" err)) nil))))
418 (or failed
419 (save-excursion
420 (set-buffer buffer)
421 (goto-char (point-max))
422 (let ((buffer-read-only nil)
423 pos-1 pos-2)
424 (or (bobp) (insert "\n"))
425 (setq pos-1 (point))
426 (insert "Hits for grep ")
427 (or (string-equal flags "") (insert flags " "))
428 (insert "\"" pattern "\" in\n " file ":\n")
429 (setq pos-2 (point))
430 (condition-case err
431 (apply
432 'call-process
433 (if compressed "sh" dired-grep-program)
434 (or temp-file file)
435 buffer t
436 (if compressed
437 (list "-c" (concat dired-grep-zcat-program
438 " |" dired-grep-program
439 " " flags " -n '" pattern "'"))
440 (append (dired-grep-parse-flags flags)
441 (list "-n" pattern))))
442 (error (setq failed (format "%s" err))))
443 (if failed
444 (progn
445 (if (= pos-2 (point-max))
446 (progn
447 (goto-char (1- pos-2))
448 (delete-char -1)
449 (insert ".")))
450 (goto-char pos-1)
451 (delete-char 4)
452 (insert "Grep failed")
453 failed)
454 (if (= pos-2 (point-max))
455 (progn
456 (goto-char pos-1)
457 (delete-char 1)
458 (insert "No h")
459 (forward-line 1)
460 (end-of-line)
461 (delete-char -1)
462 (insert "."))
463 (goto-char pos-2)
464 (or (looking-at "[0-9]+:")
465 (setq failed (buffer-substring pos-2
466 (progn (end-of-line)
467 (point))))))))))
468 (let ((curr-wind (selected-window)))
469 (unwind-protect
470 (progn
471 (pop-to-buffer buffer)
472 (goto-char (point-max)))
473 (select-window curr-wind)))
474 (if temp-file
475 (dired-grep-delete-local-temp-file temp-file))
476 failed))
477
478 ;;; Run the load hook
479
480 (run-hooks 'dired-grep-load-hook)
481
482 ;;; end of dired-grep.el