Personal emacs config
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

690 lines
26 KiB

  1. ;;; ag.el --- A front-end for ag ('the silver searcher'), the C ack replacement.
  2. ;; Copyright (C) 2013-2014 Wilfred Hughes <me@wilfred.me.uk>
  3. ;;
  4. ;; Author: Wilfred Hughes <me@wilfred.me.uk>
  5. ;; Created: 11 January 2013
  6. ;; Version: 0.48
  7. ;; Package-Version: 0.48
  8. ;; Package-Commit: bd81d68466e44301505629454dfc689b6c17d94b
  9. ;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
  10. ;;; Commentary:
  11. ;; Please see README.md for documentation, or read it online at
  12. ;; https://github.com/Wilfred/ag.el/#agel
  13. ;;; License:
  14. ;; This file is not part of GNU Emacs.
  15. ;; However, it is distributed under the same license.
  16. ;; GNU Emacs is free software; you can redistribute it and/or modify
  17. ;; it under the terms of the GNU General Public License as published by
  18. ;; the Free Software Foundation; either version 3, or (at your option)
  19. ;; any later version.
  20. ;; GNU Emacs is distributed in the hope that it will be useful,
  21. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  23. ;; GNU General Public License for more details.
  24. ;; You should have received a copy of the GNU General Public License
  25. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  26. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27. ;; Boston, MA 02110-1301, USA.
  28. ;;; Code:
  29. (require 'cl-lib) ;; cl-letf, cl-defun
  30. (require 'dired) ;; dired-sort-inhibit
  31. (require 'dash)
  32. (require 's)
  33. (require 'find-dired) ;; find-dired-filter
  34. (defgroup ag nil
  35. "A front-end for ag - The Silver Searcher."
  36. :group 'tools
  37. :group 'matching)
  38. (defcustom ag-executable
  39. "ag"
  40. "Name of the ag executable to use."
  41. :type 'string
  42. :group 'ag)
  43. (defcustom ag-arguments
  44. (list "--smart-case" "--stats")
  45. "Additional arguments passed to ag.
  46. Ag.el internally uses --column, --line-number and --color
  47. options (with specific colors) to match groups, so options
  48. specified here should not conflict.
  49. --line-number is required on Windows, as otherwise ag will not
  50. print line numbers when the input is a stream."
  51. :type '(repeat (string))
  52. :group 'ag)
  53. (defcustom ag-dired-arguments
  54. (list "--nocolor" "-S")
  55. "Additional arguments passed to ag-dired."
  56. :type '(repeat (string))
  57. :group 'ag)
  58. (defcustom ag-context-lines nil
  59. "Number of context lines to include before and after a matching line."
  60. :type 'integer
  61. :group 'ag)
  62. (defcustom ag-group-matches t
  63. "Group matches in the same file together.
  64. If nil, the file name is repeated at the beginning of every match line."
  65. :type 'boolean
  66. :group 'ag)
  67. (defcustom ag-highlight-search nil
  68. "Non-nil means we highlight the current search term in results.
  69. This requires the ag command to support --color-match, which is only in v0.14+"
  70. :type 'boolean
  71. :group 'ag)
  72. (defcustom ag-reuse-buffers nil
  73. "Non-nil means we reuse the existing search results buffer or
  74. dired results buffer, rather than creating one buffer per unique
  75. search."
  76. :type 'boolean
  77. :group 'ag)
  78. (defcustom ag-reuse-window nil
  79. "Non-nil means we open search results in the same window,
  80. hiding the results buffer."
  81. :type 'boolean
  82. :group 'ag)
  83. (defcustom ag-project-root-function nil
  84. "A function to determine the project root for `ag-project'.
  85. If set to a function, call this function with the name of the
  86. file or directory for which to determine the project root
  87. directory.
  88. If set to nil, fall back to finding VCS root directories."
  89. :type '(choice (const :tag "Default (VCS root)" nil)
  90. (function :tag "Function"))
  91. :group 'ag)
  92. (defcustom ag-ignore-list nil
  93. "A list of patterns for files/directories to ignore when searching."
  94. :type '(repeat (string))
  95. :group 'ag)
  96. (make-variable-buffer-local 'ag-ignore-list)
  97. (put 'ag-ignore-list 'safe-local-variable #'listp)
  98. (require 'compile)
  99. ;; Although ag results aren't exactly errors, we treat them as errors
  100. ;; so `next-error' and `previous-error' work. However, we ensure our
  101. ;; face inherits from `compilation-info-face' so the results are
  102. ;; styled appropriately.
  103. (defface ag-hit-face '((t :inherit compilation-info))
  104. "Face name to use for ag matches."
  105. :group 'ag)
  106. (defface ag-match-face '((t :inherit match))
  107. "Face name to use for ag matches."
  108. :group 'ag)
  109. (defvar ag-search-finished-hook nil
  110. "Hook run when ag completes a search in a buffer.")
  111. (defun ag/run-finished-hook (buffer how-finished)
  112. "Run the ag hook to signal that the search has completed."
  113. (with-current-buffer buffer
  114. (run-hooks 'ag-search-finished-hook)))
  115. (defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body)
  116. "Temporarily override the definition of FUN-NAME whilst BODY is executed.
  117. Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)."
  118. `(cl-letf (((symbol-function ,fun-name)
  119. (lambda ,fun-args ,fun-body)))
  120. ,@body))
  121. (defun ag/next-error-function (n &optional reset)
  122. "Open the search result at point in the current window or a
  123. different window, according to `ag-reuse-window'."
  124. (if ag-reuse-window
  125. ;; prevent changing the window
  126. (ag/with-patch-function
  127. 'pop-to-buffer (buffer &rest args) (switch-to-buffer buffer)
  128. (compilation-next-error-function n reset))
  129. ;; just navigate to the results as normal
  130. (compilation-next-error-function n reset)))
  131. ;; Note that we want to use as tight a regexp as we can to try and
  132. ;; handle weird file names (with colons in them) as well as possible.
  133. ;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
  134. ;; in file names.
  135. (defvar ag/file-column-pattern-nogroup
  136. "^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):"
  137. "A regexp pattern that groups output into filename, line number and column number.")
  138. (defvar ag/file-column-pattern-group
  139. "^\\([[:digit:]]+\\):\\([[:digit:]]+\\):"
  140. "A regexp pattern to match line number and column number with grouped output.")
  141. (defun ag/compilation-match-grouped-filename ()
  142. "Match filename backwards when a line/column match is found in grouped output mode."
  143. (save-match-data
  144. (save-excursion
  145. (when (re-search-backward "^File: \\(.*\\)$" (point-min) t)
  146. (list (match-string 1))))))
  147. (define-compilation-mode ag-mode "Ag"
  148. "Ag results compilation mode"
  149. (set (make-local-variable 'compilation-error-regexp-alist)
  150. '(compilation-ag-nogroup compilation-ag-group))
  151. (set (make-local-variable 'compilation-error-regexp-alist-alist)
  152. (list (cons 'compilation-ag-nogroup (list ag/file-column-pattern-nogroup 1 2 3))
  153. (cons 'compilation-ag-group (list ag/file-column-pattern-group
  154. 'ag/compilation-match-grouped-filename 1 2))))
  155. (set (make-local-variable 'compilation-error-face) 'ag-hit-face)
  156. (set (make-local-variable 'next-error-function) #'ag/next-error-function)
  157. (set (make-local-variable 'compilation-finish-functions)
  158. #'ag/run-finished-hook)
  159. (add-hook 'compilation-filter-hook 'ag-filter nil t))
  160. (define-key ag-mode-map (kbd "p") #'compilation-previous-error)
  161. (define-key ag-mode-map (kbd "n") #'compilation-next-error)
  162. (define-key ag-mode-map (kbd "k") '(lambda () (interactive)
  163. (let (kill-buffer-query-functions) (kill-buffer))))
  164. (defun ag/buffer-name (search-string directory regexp)
  165. "Return a buffer name formatted according to ag.el conventions."
  166. (cond
  167. (ag-reuse-buffers "*ag search*")
  168. (regexp (format "*ag search regexp:%s dir:%s*" search-string directory))
  169. (:else (format "*ag search text:%s dir:%s*" search-string directory))))
  170. (defun ag/format-ignore (ignores)
  171. "Prepend '--ignore' to every item in IGNORES."
  172. (apply #'append
  173. (mapcar (lambda (item) (list "--ignore" item)) ignores)))
  174. (cl-defun ag/search (string directory
  175. &key (regexp nil) (file-regex nil) (file-type nil) (files '(".")))
  176. "Run ag searching for the STRING given in DIRECTORY.
  177. If `files` is passed, tell ag to look only on those files.
  178. If REGEXP is non-nil, treat STRING as a regular expression."
  179. (let ((default-directory (file-name-as-directory directory))
  180. (arguments ag-arguments)
  181. (shell-command-switch "-c"))
  182. ;; Add double dashes at the end of command line if not specified in
  183. ;; ag-arguments.
  184. (unless (equal (car (last arguments)) "--")
  185. (setq arguments (append arguments '("--"))))
  186. (setq arguments
  187. (append '("--line-number" "--column" "--color" "--color-match" "30;43"
  188. "--color-path" "1;32")
  189. arguments))
  190. (if ag-group-matches
  191. (setq arguments (cons "--group" arguments))
  192. (setq arguments (cons "--nogroup" arguments)))
  193. (unless regexp
  194. (setq arguments (cons "--literal" arguments)))
  195. (when (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
  196. ;; Use --vimgrep to work around issue #97 on Windows.
  197. (setq arguments (cons "--vimgrep" arguments)))
  198. (when (char-or-string-p file-regex)
  199. (setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
  200. (when file-type
  201. (setq arguments (cons (format "--%s" file-type) arguments)))
  202. (if (integerp current-prefix-arg)
  203. (setq arguments (cons (format "--context=%d" (abs current-prefix-arg)) arguments))
  204. (when ag-context-lines
  205. (setq arguments (cons (format "--context=%d" ag-context-lines) arguments))))
  206. (when ag-ignore-list
  207. (setq arguments (append (ag/format-ignore ag-ignore-list) arguments)))
  208. (unless (file-exists-p default-directory)
  209. (error "No such directory %s" default-directory))
  210. (let ((command-string
  211. (mapconcat #'shell-quote-argument
  212. (append (list ag-executable) arguments (append `(,string) files))
  213. " ")))
  214. ;; If we're called with a prefix, let the user modify the command before
  215. ;; running it. Typically this means they want to pass additional arguments.
  216. ;; The numeric value is used for context lines: positive is just context
  217. ;; number (no modification), negative allows further modification.
  218. (when (and current-prefix-arg (not (and (integerp current-prefix-arg) (> current-prefix-arg 0))))
  219. ;; Make a space in the command-string for the user to enter more arguments.
  220. (setq command-string (ag/replace-first command-string " -- " " -- "))
  221. ;; Prompt for the command.
  222. (let ((adjusted-point (- (length command-string) (length string) 5)))
  223. (setq command-string
  224. (read-from-minibuffer "ag command: "
  225. (cons command-string adjusted-point)))))
  226. ;; Call ag.
  227. (compilation-start
  228. command-string
  229. #'ag-mode
  230. `(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
  231. (defun ag/dwim-at-point ()
  232. "If there's an active selection, return that.
  233. Otherwise, get the symbol at point, as a string."
  234. (cond ((use-region-p)
  235. (buffer-substring-no-properties (region-beginning) (region-end)))
  236. ((symbol-at-point)
  237. (substring-no-properties
  238. (symbol-name (symbol-at-point))))))
  239. (defun ag/buffer-extension-regex ()
  240. "If the current buffer has an extension, return
  241. a PCRE pattern that matches files with that extension.
  242. Returns an empty string otherwise."
  243. (let ((file-name (buffer-file-name)))
  244. (if (stringp file-name)
  245. (format "\\.%s$" (ag/escape-pcre (file-name-extension file-name)))
  246. "")))
  247. (defun ag/longest-string (&rest strings)
  248. "Given a list of strings and nils, return the longest string."
  249. (let ((longest-string nil))
  250. (dolist (string (-non-nil strings))
  251. (when (< (length longest-string)
  252. (length string))
  253. (setq longest-string string)))
  254. longest-string))
  255. (defun ag/replace-first (string before after)
  256. "Replace the first occurrence of BEFORE in STRING with AFTER."
  257. (replace-regexp-in-string
  258. (concat "\\(" (regexp-quote before) "\\)" ".*\\'")
  259. after string
  260. nil nil 1))
  261. (autoload 'vc-git-root "vc-git")
  262. (require 'vc-svn)
  263. ;; Emacs 23.4 doesn't provide vc-svn-root.
  264. (unless (functionp 'vc-svn-root)
  265. (defun vc-svn-root (file)
  266. (vc-find-root file vc-svn-admin-directory)))
  267. (autoload 'vc-hg-root "vc-hg")
  268. (autoload 'vc-bzr-root "vc-bzr")
  269. (defun ag/project-root (file-path)
  270. "Guess the project root of the given FILE-PATH.
  271. Use `ag-project-root-function' if set, or fall back to VCS
  272. roots."
  273. (if ag-project-root-function
  274. (funcall ag-project-root-function file-path)
  275. (or (ag/longest-string
  276. (vc-git-root file-path)
  277. (vc-svn-root file-path)
  278. (vc-hg-root file-path)
  279. (vc-bzr-root file-path))
  280. file-path)))
  281. (defun ag/dired-align-size-column ()
  282. (beginning-of-line)
  283. (when (looking-at "^ ")
  284. (forward-char 2)
  285. (search-forward " " nil t 4)
  286. (let* ((size-start (point))
  287. (size-end (search-forward " " nil t))
  288. (width (and size-end (- size-end size-start))))
  289. (when (and size-end
  290. (< width 12)
  291. (> width 1))
  292. (goto-char size-start)
  293. (insert (make-string (- 12 width) ? ))))))
  294. (defun ag/dired-filter (proc string)
  295. "Filter the output of ag to make it suitable for `dired-mode'."
  296. (let ((buf (process-buffer proc))
  297. (inhibit-read-only t))
  298. (if (buffer-name buf)
  299. (with-current-buffer buf
  300. (save-excursion
  301. (save-restriction
  302. (widen)
  303. (let ((beg (point-max)))
  304. (goto-char beg)
  305. (insert string)
  306. (goto-char beg)
  307. (or (looking-at "^")
  308. (progn
  309. (ag/dired-align-size-column)
  310. (forward-line 1)))
  311. (while (looking-at "^")
  312. (insert " ")
  313. (ag/dired-align-size-column)
  314. (forward-line 1))
  315. (goto-char beg)
  316. (beginning-of-line)
  317. ;; Remove occurrences of default-directory.
  318. (while (search-forward (concat " " default-directory) nil t)
  319. (replace-match " " nil t))
  320. (goto-char (point-max))
  321. (if (search-backward "\n" (process-mark proc) t)
  322. (progn
  323. (dired-insert-set-properties (process-mark proc)
  324. (1+ (point)))
  325. (move-marker (process-mark proc) (1+ (point)))))))))
  326. (delete-process proc))))
  327. (defun ag/dired-sentinel (proc state)
  328. "Update the status/modeline after the process finishes."
  329. (let ((buf (process-buffer proc))
  330. (inhibit-read-only t))
  331. (if (buffer-name buf)
  332. (with-current-buffer buf
  333. (let ((buffer-read-only nil))
  334. (save-excursion
  335. (goto-char (point-max))
  336. (insert "\n ag " state)
  337. (forward-char -1) ;Back up before \n at end of STATE.
  338. (insert " at " (substring (current-time-string) 0 19))
  339. (forward-char 1)
  340. (setq mode-line-process
  341. (concat ":" (symbol-name (process-status proc))))
  342. ;; Since the buffer and mode line will show that the
  343. ;; process is dead, we can delete it now. Otherwise it
  344. ;; will stay around until M-x list-processes.
  345. (delete-process proc)
  346. (force-mode-line-update)))
  347. (run-hooks 'dired-after-readin-hook)
  348. (message "%s finished." (current-buffer))))))
  349. (defun ag/kill-process ()
  350. "Kill the `ag' process running in the current buffer."
  351. (interactive)
  352. (let ((ag (get-buffer-process (current-buffer))))
  353. (and ag (eq (process-status ag) 'run)
  354. (eq (process-filter ag) (function find-dired-filter))
  355. (condition-case nil
  356. (delete-process ag)
  357. (error nil)))))
  358. (defun ag/escape-pcre (regexp)
  359. "Escape the PCRE-special characters in REGEXP so that it is
  360. matched literally."
  361. (let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
  362. (apply #'concat
  363. (mapcar
  364. (lambda (c)
  365. (cond
  366. ((not (string-match-p (regexp-quote c) alphanum))
  367. (concat "\\" c))
  368. (t c)))
  369. (mapcar #'char-to-string (string-to-list regexp))))))
  370. ;;;###autoload
  371. (defun ag (string directory)
  372. "Search using ag in a given DIRECTORY for a given literal search STRING,
  373. with STRING defaulting to the symbol under point.
  374. If called with a prefix, prompts for flags to pass to ag."
  375. (interactive (list (ag/read-from-minibuffer "Search string")
  376. (read-directory-name "Directory: ")))
  377. (ag/search string directory))
  378. ;;;###autoload
  379. (defun ag-files (string file-type directory)
  380. "Search using ag in a given DIRECTORY for a given literal search STRING,
  381. limited to files that match FILE-TYPE. STRING defaults to the
  382. symbol under point.
  383. If called with a prefix, prompts for flags to pass to ag."
  384. (interactive (list (ag/read-from-minibuffer "Search string")
  385. (ag/read-file-type)
  386. (read-directory-name "Directory: ")))
  387. (apply #'ag/search string directory file-type))
  388. ;;;###autoload
  389. (defun ag-regexp (string directory)
  390. "Search using ag in a given directory for a given regexp.
  391. The regexp should be in PCRE syntax, not Emacs regexp syntax.
  392. If called with a prefix, prompts for flags to pass to ag."
  393. (interactive "sSearch regexp: \nDDirectory: ")
  394. (ag/search string directory :regexp t))
  395. ;;;###autoload
  396. (defun ag-project (string)
  397. "Guess the root of the current project and search it with ag
  398. for the given literal search STRING.
  399. If called with a prefix, prompts for flags to pass to ag."
  400. (interactive (list (ag/read-from-minibuffer "Search string")))
  401. (ag/search string (ag/project-root default-directory)))
  402. ;;;###autoload
  403. (defun ag-project-files (string file-type)
  404. "Search using ag for a given literal search STRING,
  405. limited to files that match FILE-TYPE. STRING defaults to the
  406. symbol under point.
  407. If called with a prefix, prompts for flags to pass to ag."
  408. (interactive (list (ag/read-from-minibuffer "Search string")
  409. (ag/read-file-type)))
  410. (apply 'ag/search string (ag/project-root default-directory) file-type))
  411. (defun ag/read-from-minibuffer (prompt)
  412. "Read a value from the minibuffer with PROMPT.
  413. If there's a string at point, offer that as a default."
  414. (let* ((suggested (ag/dwim-at-point))
  415. (final-prompt
  416. (if suggested
  417. (format "%s (default %s): " prompt suggested)
  418. (format "%s: " prompt)))
  419. ;; Ask the user for input, but add `suggested' to the history
  420. ;; so they can use M-n if they want to modify it.
  421. (user-input (read-from-minibuffer
  422. final-prompt
  423. nil nil nil nil suggested)))
  424. ;; Return the input provided by the user, or use `suggested' if
  425. ;; the input was empty.
  426. (if (> (length user-input) 0)
  427. user-input
  428. suggested)))
  429. ;;;###autoload
  430. (defun ag-project-regexp (regexp)
  431. "Guess the root of the current project and search it with ag
  432. for the given regexp. The regexp should be in PCRE syntax, not
  433. Emacs regexp syntax.
  434. If called with a prefix, prompts for flags to pass to ag."
  435. (interactive (list (ag/read-from-minibuffer "Search regexp")))
  436. (ag/search regexp (ag/project-root default-directory) :regexp t))
  437. (autoload 'symbol-at-point "thingatpt")
  438. ;;;###autoload
  439. (defalias 'ag-project-at-point 'ag-project)
  440. (make-obsolete 'ag-project-at-point 'ag-project "0.19")
  441. ;;;###autoload
  442. (defalias 'ag-regexp-project-at-point 'ag-project-regexp)
  443. (make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46")
  444. ;;;###autoload
  445. (defun ag-dired (dir string)
  446. "Recursively find files in DIR matching literal search STRING.
  447. The PATTERN is matched against the full path to the file, not
  448. only against the file name.
  449. The results are presented as a `dired-mode' buffer with
  450. `default-directory' being DIR.
  451. See also `ag-dired-regexp'."
  452. (interactive "DDirectory: \nsFile pattern: ")
  453. (ag-dired-regexp dir (ag/escape-pcre string)))
  454. ;;;###autoload
  455. (defun ag-dired-regexp (dir regexp)
  456. "Recursively find files in DIR matching REGEXP.
  457. REGEXP should be in PCRE syntax, not Emacs regexp syntax.
  458. The REGEXP is matched against the full path to the file, not
  459. only against the file name.
  460. Results are presented as a `dired-mode' buffer with
  461. `default-directory' being DIR.
  462. See also `find-dired'."
  463. (interactive "DDirectory: \nsFile regexp: ")
  464. (let* ((dired-buffers dired-buffers) ;; do not mess with regular dired buffers
  465. (orig-dir dir)
  466. (dir (file-name-as-directory (expand-file-name dir)))
  467. (buffer-name (if ag-reuse-buffers
  468. "*ag dired*"
  469. (format "*ag dired pattern:%s dir:%s*" regexp dir)))
  470. (cmd (if (string= system-type "windows-nt")
  471. (concat ag-executable " " (combine-and-quote-strings ag-dired-arguments " ") " -g \"" regexp "\" "
  472. (shell-quote-argument dir)
  473. " | grep -v \"^$\" | sed \"s/'/\\\\\\\\'/g\" | xargs -I '{}' "
  474. insert-directory-program " "
  475. dired-listing-switches " '{}' &")
  476. (concat ag-executable " " (combine-and-quote-strings ag-dired-arguments " ") " -g '" regexp "' "
  477. (shell-quote-argument dir)
  478. " | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/g | xargs -I '{}' "
  479. insert-directory-program " "
  480. dired-listing-switches " '{}' &"))))
  481. (with-current-buffer (get-buffer-create buffer-name)
  482. (switch-to-buffer (current-buffer))
  483. (widen)
  484. (kill-all-local-variables)
  485. (if (fboundp 'read-only-mode)
  486. (read-only-mode -1)
  487. (setq buffer-read-only nil))
  488. (let ((inhibit-read-only t)) (erase-buffer))
  489. (setq default-directory dir)
  490. (run-hooks 'dired-before-readin-hook)
  491. (shell-command cmd (current-buffer))
  492. (insert " " dir ":\n")
  493. (insert " " cmd "\n")
  494. (dired-mode dir)
  495. (let ((map (make-sparse-keymap)))
  496. (set-keymap-parent map (current-local-map))
  497. (define-key map "\C-c\C-k" 'ag/kill-process)
  498. (use-local-map map))
  499. (set (make-local-variable 'dired-sort-inhibit) t)
  500. (set (make-local-variable 'revert-buffer-function)
  501. `(lambda (ignore-auto noconfirm)
  502. (ag-dired-regexp ,orig-dir ,regexp)))
  503. (if (fboundp 'dired-simple-subdir-alist)
  504. (dired-simple-subdir-alist)
  505. (set (make-local-variable 'dired-subdir-alist)
  506. (list (cons default-directory (point-min-marker)))))
  507. (let ((proc (get-buffer-process (current-buffer))))
  508. (set-process-filter proc #'ag/dired-filter)
  509. (set-process-sentinel proc #'ag/dired-sentinel)
  510. ;; Initialize the process marker; it is used by the filter.
  511. (move-marker (process-mark proc) 1 (current-buffer)))
  512. (setq mode-line-process '(":%s")))))
  513. ;;;###autoload
  514. (defun ag-project-dired (pattern)
  515. "Recursively find files in current project matching PATTERN.
  516. See also `ag-dired'."
  517. (interactive "sFile pattern: ")
  518. (ag-dired-regexp (ag/project-root default-directory) (ag/escape-pcre pattern)))
  519. ;;;###autoload
  520. (defun ag-project-dired-regexp (regexp)
  521. "Recursively find files in current project matching REGEXP.
  522. See also `ag-dired-regexp'."
  523. (interactive "sFile regexp: ")
  524. (ag-dired-regexp (ag/project-root default-directory) regexp))
  525. ;;;###autoload
  526. (defun ag-kill-buffers ()
  527. "Kill all `ag-mode' buffers."
  528. (interactive)
  529. (dolist (buffer (buffer-list))
  530. (when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
  531. (kill-buffer buffer))))
  532. ;;;###autoload
  533. (defun ag-kill-other-buffers ()
  534. "Kill all `ag-mode' buffers other than the current buffer."
  535. (interactive)
  536. (let ((current-buffer (current-buffer)))
  537. (dolist (buffer (buffer-list))
  538. (when (and
  539. (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
  540. (not (eq buffer current-buffer)))
  541. (kill-buffer buffer)))))
  542. ;; Based on grep-filter.
  543. (defun ag-filter ()
  544. "Handle escape sequences inserted by the ag process.
  545. This function is called from `compilation-filter-hook'."
  546. (save-excursion
  547. (forward-line 0)
  548. (let ((end (point)) beg)
  549. (goto-char compilation-filter-start)
  550. (forward-line 0)
  551. (setq beg (point))
  552. ;; Only operate on whole lines so we don't get caught with part of an
  553. ;; escape sequence in one chunk and the rest in another.
  554. (when (< (point) end)
  555. (setq end (copy-marker end))
  556. (when ag-highlight-search
  557. ;; Highlight ag matches and delete marking sequences.
  558. (while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[0m\033\\[K" end 1)
  559. (replace-match (propertize (match-string 1)
  560. 'face nil 'font-lock-face 'ag-match-face)
  561. t t)))
  562. ;; Add marker at start of line for files. This is used by the match
  563. ;; in `compilation-error-regexp-alist' to extract the file name.
  564. (when ag-group-matches
  565. (goto-char beg)
  566. (while (re-search-forward "\033\\[1;32m\\(.*\\)\033\\[0m\033\\[K" end 1)
  567. (replace-match
  568. (concat "File: " (propertize (match-string 1) 'face nil 'font-lock-face
  569. 'compilation-info))
  570. t t)))
  571. ;; Delete all remaining escape sequences
  572. (goto-char beg)
  573. (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
  574. (replace-match "" t t))))))
  575. (defun ag/get-supported-types ()
  576. "Query the ag executable for which file types it recognises."
  577. (let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable)))
  578. (lines (-map #'s-trim (s-lines ag-output)))
  579. (types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines))
  580. (extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines))))
  581. (-zip types extensions)))
  582. (defun ag/read-file-type ()
  583. "Prompt the user for a known file type, or let them specify a PCRE regex."
  584. (let* ((all-types-with-extensions (ag/get-supported-types))
  585. (all-types (mapcar 'car all-types-with-extensions))
  586. (file-type
  587. (completing-read "Select file type: "
  588. (append '("custom (provide a PCRE regex)") all-types)))
  589. (file-type-extensions
  590. (cdr (assoc file-type all-types-with-extensions))))
  591. (if file-type-extensions
  592. (list :file-type file-type)
  593. (list :file-regex
  594. (read-from-minibuffer "Filenames which match PCRE: "
  595. (ag/buffer-extension-regex))))))
  596. (provide 'ag)
  597. ;;; ag.el ends here