(require 'cl)
(require 'htmlize)

(defun egrep-1 (result-buffer regexp predicate args)
  (let ((file-name (buffer-file-name)))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward regexp nil t)
        (if (or (not predicate) (save-excursion (goto-char (match-beginning 0))
                                                (apply predicate args)))
            (let ((line (count-lines (point-min) (point)))
                  (column (current-column))
                  (text (buffer-substring (save-excursion (beginning-of-line) (point))
                                          (save-excursion (end-of-line) (point)))))
              (with-current-buffer result-buffer
                (let ((inhibit-read-only t))
                  (insert (format "%s:%d:%d: %s\n"
                                  (dired-make-relative file-name default-directory)
                                  line column text))))
              ; only one match / line
              (forward-line 1)))))))

(defun egrep-prepare-result-buffer ()
  (let ((result-buffer (get-buffer-create "*egrep*")))
    (with-current-buffer result-buffer
      (let ((inhibit-read-only t))
        (grep-mode)
        (erase-buffer)
        (insert (format "; Searching for '%s' ...\n" regexp))
        (pop-to-buffer result-buffer)))
    result-buffer))

(defun egrep-finalize-result-buffer (result-buffer)
  (goto-char (point-min)))

(defun egrep (regexp &optional predicate &rest args)
  (interactive "sRegexp: ")
  (let ((result-buffer (egrep-prepare-result-buffer)))
    (egrep-1 result-buffer regexp predicate args)
    (egrep-finalize-result-buffer result-buffer)))

(defun egrep-font-face-predicate (face-symbol)
  (loop for point from (match-beginning 0) to (1- (match-end 0))
        if (not (eq  (get-text-property point 'face) face-symbol)) return nil
        finally return t))

(defun egrep-with-face (regexp face-symbol)
  (interactive (list (read-string "Regexp: ")
                     (intern (completing-read "Face symbol: "
                                              (mapcar (lambda (face) (symbol-name face)) (face-list))
                                              nil t))))
  (egrep regexp 'egrep-font-face-predicate face-symbol))

(defun egrep-dired-marked-files (regexp &optional prepare predicate &rest args)
  (interactive "sRegexp: ")
  (let ((result-buffer (egrep-prepare-result-buffer)))
    (loop for file-name in (dired-get-marked-files nil current-prefix-arg)
          do (let ((buffer (find-file-noselect file-name)))
               (with-current-buffer buffer
                 (message (format "Searching %s ..." (file-name-nondirectory file-name)))
                 (sit-for .1)
                 (if prepare (funcall prepare))
                 (egrep-1 result-buffer regexp predicate args))))
    (egrep-finalize-result-buffer result-buffer)
    (message "Search complete.")))

(defun egrep-string-startswith (string start)
  (and (> (length string) (length start))
       (string= (substring string 0 (length start)) start)))

(defun egrep-grep-list (func list)
  (let (r)
    (while list
      (if (funcall func (car list))
          (setq r (cons (car list) r)))
      (setq list (cdr list)))
    (nreverse r)))

(defun egrep-read-font-lock-face (prompt &optional predicate initial hist default inherit-input-method)
  (intern (completing-read prompt
                           (egrep-grep-list (lambda (font) (egrep-string-startswith font "font-lock-"))
                                            (mapcar (lambda (face) (symbol-name face)) (face-list)))
                           predicate  t (or initial "font-lock-") hist default inherit-input-method)))

(defun egrep-with-face-dired-marked-files (regexp face-symbol)
  (interactive (list (read-string "Regexp: ")
                     (egrep-read-font-lock-face "Font symbol: ")))
  (egrep-dired-marked-files regexp
                            (lambda ()
                              (font-lock-fontify-buffer)
                              (htmlize-ensure-fontified))
                            'egrep-font-face-predicate
                            face-symbol))

(provide 'egrep)