;;; ag.el --- Ag frontend

;;; Commentary:

;;

(defgroup my-ag nil

  "My own ag search front-end."

  :prefix "my-ag"

  :group 'tools

  :group 'processes)

(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-number (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-char (point-min))

        (forward-line (1- 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."

  :group 'my-ag)

(defface my-ag/path-face

  '((t :inherit success))

  "Face for line number."

  :group 'my-ag)

(defvar my-ag/keywords

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

    ("^[^:]\\{6\\}.*" . (0 'my-ag/path-face))))

(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)

  (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 &optional args)

  (let ((default-directory (buffer-local-value 'default-directory my-ag/buffer))

        (cmd (list "ag" "--group" "--nocolor" "--hidden")))

    (when args

      (nconc cmd (split-string args)))

    (nconc cmd (list "--" regex))

    (make-process

     :name "ag"

     :buffer my-ag/buffer

     :filter 'my-ag/filter

     :command cmd)))

(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)))

(defvar my-ag/extra-history nil)

(defun my-ag/read-extra ()

  (let* ( (def (when my-ag/extra-history (car my-ag/extra-history)))

          (part (when def (if (< (length def) 20)

                              def

                            (concat (substring def 0 20) "...")))) )

    (read-string

     (if part (format "Extra args [%s]: " part) "Extra args: ")

     ""  'my-ag/extra-history  def  t)))

;;;###autoload

(defun my-ag (regex &optional args)

  "Search in 'ag' recursively from VCS root directory and fall to

current directory if VCS root is not defined."

  (interactive (if (equal current-prefix-arg '(16))

                   (list (my-ag/read-regex) (my-ag/read-extra))

                 (list (my-ag/read-regex))))

  (my-ag/setup-buffer (if current-prefix-arg default-directory (my-ag/project-root)))

  (my-ag/run regex args))

;;;###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