1 ;;; ag.el --- Ag frontend

     2 

     3 ;;; Commentary:

     4 ;;

     5 

     6 (defgroup my-ag nil

     7   "My own ag search front-end."

     8   :prefix "my-ag"

     9   :group 'tools

    10   :group 'processes)

    11 

    12 (defun my-ag-goto ()

    13   (interactive)

    14   (save-excursion

    15     (let ( lineno end )

    16       (forward-line 1)

    17       (backward-char 1)

    18       (setq end (point))

    19       (forward-line 0)

    20       (if (not (search-forward-regexp "^\\([1-9][0-9]*\\)[:-]" end t))

    21           (message "Not at line number...")

    22         (setq lineno (string-to-number (match-string 1)))

    23         (if (search-backward-regexp "^$" nil t)

    24             (forward-char)

    25           (goto-char (point-min)))

    26         (search-forward-regexp "^.*")

    27         (find-file-other-window (match-string 0))

    28         (goto-char (point-min))

    29         (forward-line (1- lineno))))))

    30 

    31 (defun my-ag-kill-process ()

    32   (interactive)

    33   (let ( (proc (get-buffer-process (current-buffer))) )

    34     (if proc

    35 	(interrupt-process proc)

    36       (error "The %s process is not running" (downcase mode-name)))))

    37 

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

    39 

    40 (define-key my-ag-mode-map (kbd "RET") 'my-ag-goto)

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

    42 

    43 (defface my-ag/lineno-face

    44   '((t :inherit warning))

    45   "Face for line number."

    46   :group 'my-ag)

    47 (defface my-ag/path-face

    48   '((t :inherit success))

    49   "Face for line number."

    50   :group 'my-ag)

    51 

    52 (defvar my-ag/keywords

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

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

    55 

    56 (define-derived-mode my-ag-mode fundamental-mode "Ag"

    57   "Major mode for Ag parsing."

    58   (setq font-lock-defaults '(my-ag/keywords t nil nil)) ;  (font-lock-multiline . t)

    59   (use-local-map my-ag-mode-map))

    60 

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

    62 (defvar my-ag/buffer nil)

    63 

    64 (defun my-ag/filter (proc str)

    65   (when (buffer-live-p (process-buffer proc))

    66     (with-current-buffer (process-buffer proc)

    67       (save-excursion

    68         (goto-char (process-mark proc))

    69         (insert str)

    70         (set-marker (process-mark proc) (point)))

    71       )))

    72 

    73 (defvar my-ag/regex-history nil)

    74 

    75 (defun my-ag/setup-buffer (dir)

    76   (setq my-ag/buffer (get-buffer-create my-ag/buffer-name))

    77   (with-current-buffer my-ag/buffer

    78     (setq default-directory dir)

    79     (erase-buffer)

    80     (my-ag-mode))

    81   (display-buffer my-ag/buffer))

    82 

    83 (defun my-ag/run (regex &optional args)

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

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

    86     (when args

    87       (nconc cmd (split-string args)))

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

    89     (make-process

    90      :name "ag"

    91      :buffer my-ag/buffer

    92      :filter 'my-ag/filter

    93      :command cmd)))

    94 

    95 (defun my-ag/project-root ()

    96   (condition-case err

    97       (let ( backend )

    98         (setq backend (vc-responsible-backend default-directory))

    99         (if backend

   100             (vc-call-backend backend 'root default-directory)

   101           default-directory))

   102     (error default-directory)))

   103 

   104 (defun my-ag/read-regex ()

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

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

   107                               def

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

   109     (read-string

   110      (if part (format "Regex [%s]: " part) "Regex: ")

   111      ""  'my-ag/regex-history  def  t)))

   112 

   113 (defvar my-ag/extra-history nil)

   114 

   115 (defun my-ag/read-extra ()

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

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

   118                               def

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

   120     (read-string

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

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

   123 

   124 ;;;###autoload

   125 (defun my-ag (regex &optional args)

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

   127 current directory if VCS root is not defined."

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

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

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

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

   132   (my-ag/run regex args))

   133 

   134 ;;;###autoload

   135 (defun my-ag-default-directory (regex)

   136   "Search in 'ag' recursively from current directory."

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

   138   (my-ag/setup-buffer default-directory)

   139   (my-ag/run regex))

   140 

   141 

   142 (provide 'ag)

   143 

   144 ;;; ag.el ends here