;;; ag.el --- Ag frontend

;;; Commentary:
;;

(defun my/ag-goto ()
  (interactive)
  (save-excursion
    (let ( lineno end )
      (forward-line 1)
      (backward-char 1)
      (setq end (point))
      (forward-line 0)
      (if (not (search-forward-regexp "^\\([1-9][0-9]*\\):" end t))
          (message "Not at line number...")
        (setq lineno (string-to-int (match-string 1)))
        (if (search-backward-regexp "^$" nil t)
            (forward-char)
          (goto-char (point-min)))
        (search-forward-regexp "^.*")
        (find-file-other-window (match-string 0))
        (goto-line lineno)))))

(defun my/ag-kill-process ()
  (interactive)
  (let ( (proc (get-buffer-process (current-buffer))) )
    (if proc
	(interrupt-process proc)
      (error "The %s process is not running" (downcase mode-name)))))

(defvar my/ag-mode-map (make-sparse-keymap))

(define-key my/ag-mode-map (kbd "RET") 'my/ag-goto)
(define-key my/ag-mode-map (kbd "C-c C-k") 'my/ag-kill-process)

(defface my/ag-lineno-face
  '((t :inherit warning))
  "Face for line number.")
(defface my/ag-path-face
  '((t :inherit success))
  "Face for line number.")

(defvar my/ag-keywords
  '(("^[1-9][0-9]\\{0,5\\}:" . (0 'my/ag-lineno-face))
    ("^[^:]\\{6\\}.*" . (0 'my/ag-path-face))))

(defun my/ag-font-lock-extend-region ()
  (save-excursion
    (goto-char font-lock-beg)
    (forward-line 2)
    (setq font-lock-beg (point))))

(define-derived-mode my/ag-mode fundamental-mode "Ag"
  "Major mode for Ag parsing."
  (setq font-lock-defaults '(my/ag-keywords t nil nil)) ;  (font-lock-multiline . t)
  ;; (add-hook 'font-lock-extend-region-functions 'my/ag-font-lock-extend-region)
  (use-local-map my/ag-mode-map))

(defvar my/ag-buffer-name "*ag*")
(defvar my/ag-buffer nil)

(defun my/ag-filter (proc str)
  (when (buffer-live-p (process-buffer proc))
    (with-current-buffer (process-buffer proc)
      (save-excursion
        (goto-char (process-mark proc))
        (insert str)
        (set-marker (process-mark proc) (point)))
      )))

(defvar my/ag-regex-history nil)

(defun my/ag-setup-buffer (dir)
  (setq my/ag-buffer (get-buffer-create my/ag-buffer-name))
  (with-current-buffer my/ag-buffer
    (setq default-directory dir)
    (erase-buffer)
    (my/ag-mode))
  (display-buffer my/ag-buffer))

(defun my/ag-run (regex)
  (let ( (default-directory (buffer-local-value 'default-directory my/ag-buffer)) )
    (make-process
     :name "ag"
     :buffer my/ag-buffer
     :filter 'my/ag-filter
     :command (list "ag" "--group" "--nocolor" regex))))

(defun my/ag-project-root ()
  (condition-case err
      (let ( backend )
        (setq backend (vc-responsible-backend default-directory))
        (if backend
            (vc-call-backend backend 'root default-directory)
          default-directory))
    (error default-directory)))

(defun my/ag-read-regex ()
  (let* ( (def (when my/ag-regex-history (car my/ag-regex-history)))
          (part (when def (if (< (length def) 20)
                              def
                            (concat (substring def 0 20) "...")))) )
    (read-string
     (if part (format "Regex [%s]: " part) "Regex: ")
     ""  'my/ag-regex-history  def  t)))

;;;###autoload
(defun my/ag (regex)
  "Search in 'ag' recursively from VCS root directory and fall to
current directory if VCS root is not defined."
  (interactive (list (my/ag-read-regex)))
  (my/ag-setup-buffer (if current-prefix-arg default-directory (my/ag-project-root)))
  (my/ag-run regex))

;;;###autoload
(defun my/ag-default-directory (regex)
  "Search in 'ag' recursively from current directory."
  (interactive (list (my/ag-read-regex)))
  (my/ag-setup-buffer default-directory)
  (my/ag-run regex))


(provide 'ag)

;;; ag.el ends here