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