egrep.el

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