dda564499e2bbd7425dde12a1908fd3bad084809
[emacs-egrep.git] / egrep.el
1 (require 'cl)
2 (require 'htmlize)
3
4 (defun egrep-regexps-1 (result-buffer regexp predicate args)
5   (let ((file-name (buffer-file-name)))
6     (save-excursion
7       (goto-char (point-min))
8       (while (re-search-forward regexp nil t)
9         (if (or (not predicate) (apply predicate args))
10             (let ((line (count-lines (point-min) (point)))
11                   (column (current-column))
12                   (text (buffer-substring (save-excursion (beginning-of-line) (point))
13                                           (save-excursion (end-of-line) (point)))))
14             (with-current-buffer result-buffer
15               (let ((inhibit-read-only t))
16                 (insert (format "%s:%d:%d: %s\n"
17                                 (dired-make-relative file-name default-directory)
18                                 line column text))))))))))
19
20 (defun egrep-prepare-result-buffer ()
21   (let ((result-buffer (get-buffer-create "*search*")))
22     (with-current-buffer result-buffer
23       (let ((inhibit-read-only t))
24         (grep-mode)
25         (erase-buffer)
26         (insert (format "; Searching for '%s' ...\n" regexp))))
27     result-buffer))
28
29 (defun egrep-finalize-result-buffer (result-buffer)
30   (pop-to-buffer result-buffer)
31   (goto-char (point-min)))
32
33 (defun egrep-regexps (regexp &optional predicate &rest args)
34   (interactive "sRegexp: ")
35   (let ((result-buffer (egrep-prepare-result-buffer)))
36     (egrep-regexps-1 result-buffer regexp predicate args)
37     (egrep-finalize-result-buffer result-buffer)))
38
39 (defun egrep-font-face-predicate (face-symbol)
40   (eq (get-text-property (point) 'face) face-symbol))
41
42 (defun egrep-regexps-with-face (regexp face-symbol)
43   (interactive (list (read-string "Regexp: ")
44                      (intern (completing-read "Face symbol: "
45                                               (mapcar (lambda (face) (symbol-name face)) (face-list))
46                                               nil t))))
47   (egrep-regexps regexp 'egrep-font-face-predicate face-symbol))
48
49 (defun egrep-regexps-dired-marked-files (regexp &optional prepare predicate &rest args)
50   (interactive "sRegexp: ")
51   (let ((result-buffer (egrep-prepare-result-buffer)))
52     (loop for file-name in (dired-get-marked-files nil current-prefix-arg)
53           do (let ((buffer (find-file-noselect file-name)))
54                (with-current-buffer buffer
55                  (message (format "Search '%s'" file-name))
56                  (sit-for .1)
57                  (if prepare (funcall prepare))
58                  (egrep-regexps-1 result-buffer regexp predicate args))))
59     (egrep-finalize-result-buffer result-buffer)))
60
61 (defun egrep-string-startswith (string start)
62   (and (> (length string) (length start))
63        (string= (substring string 0 (length start)) start)))
64
65 (defun egrep-grep-list (func list)
66   (let (r)
67     (while list
68       (if (funcall func (car list))
69           (setq r (cons (car list) r)))
70       (setq list (cdr list)))
71     (nreverse r)))
72
73 (defun egrep-read-font-lock-face (prompt &optional predicate initial hist default inherit-input-method)
74   (intern (completing-read prompt
75                            (egrep-grep-list (lambda (font) (egrep-string-startswith font "font-lock-"))
76                                             (mapcar (lambda (face) (symbol-name face)) (face-list)))
77                            predicate  t (or initial "font-lock-") hist default inherit-input-method)))
78
79 (defun egrep-regexps-with-face-dired-marked-files (regexp face-symbol)
80   (interactive (list (read-string "Regexp: ")
81                      (egrep-read-font-lock-face "Font symbol: ")))
82   (egrep-regexps-dired-marked-files regexp
83                                     (lambda ()
84                                       (font-lock-fontify-buffer)
85                                       (htmlize-ensure-fontified))
86                                     'egrep-font-face-predicate
87                                     face-symbol))
88
89 (provide 'egrep)