PageRenderTime 29ms CodeModel.GetById 33ms RepoModel.GetById 0ms app.codeStats 1ms

/elpa-local/28.1/helm-rg-20200721.725/helm-rg.el

https://github.com/MassimoLauria/dotemacs
Emacs Lisp | 1222 lines | 857 code | 170 blank | 195 comment | 77 complexity | 4eff24311d28b38d6ac4a6736f276fea MD5 | raw file
Possible License(s): GPL-3.0, CC-BY-4.0, BSD-3-Clause
  1. ;;; helm-rg.el --- a helm interface to ripgrep -*- lexical-binding: t -*-
  2. ;; Author: Danny McClanahan
  3. ;; Version: 0.1
  4. ;; Package-Version: 20200721.725
  5. ;; Package-Commit: ee0a3c09da0c843715344919400ab0a0190cc9dc
  6. ;; URL: https://github.com/cosmicexplorer/helm-rg
  7. ;; Package-Requires: ((emacs "25") (cl-lib "0.5") (dash "2.13.0") (helm "2.8.8"))
  8. ;; Keywords: find, file, files, helm, fast, rg, ripgrep, grep, search, match
  9. ;; This file is not part of GNU Emacs.
  10. ;; This file is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 3, or (at your option)
  13. ;; any later version.
  14. ;; This file is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  20. ;;; Commentary:
  21. ;; The below is generated from a README at
  22. ;; https://github.com/cosmicexplorer/helm-rg.
  23. ;; MELPA: https://melpa.org/#/helm-rg
  24. ;; !`helm-rg' example usage (./emacs-helm-rg.png)
  25. ;; Search massive codebases extremely fast, using `ripgrep'
  26. ;; (https://github.com/BurntSushi/ripgrep) and `helm'
  27. ;; (https://github.com/emacs-helm/helm). Inspired by `helm-ag'
  28. ;; (https://github.com/syohex/emacs-helm-ag) and `f3'
  29. ;; (https://github.com/cosmicexplorer/f3).
  30. ;; Also check out rg.el (https://github.com/dajva/rg.el), which I haven't used
  31. ;; much but seems pretty cool.
  32. ;; Usage:
  33. ;; *See the `ripgrep' whirlwind tour
  34. ;; (https://github.com/BurntSushi/ripgrep#whirlwind-tour) for further
  35. ;; information on invoking `ripgrep'.*
  36. ;; - Invoke the interactive function `helm-rg' to start a search with `ripgrep'
  37. ;; in the current directory.
  38. ;; - `helm' is used to browse the results and update the output as you
  39. ;; type.
  40. ;; - Each line has the file path, the line number, and the column number of
  41. ;; the start of the match, and each part is highlighted differently.
  42. ;; - Use `TAB' to invoke the helm persistent action, which previews the
  43. ;; result and highlights the matched text in the preview.
  44. ;; - Use `RET' to visit the file containing the result, move point to the
  45. ;; start of the match, and recenter.
  46. ;; - The result's buffer is displayed with
  47. ;; `helm-rg-display-buffer-normal-method' (which defaults to
  48. ;; `switch-to-buffer').
  49. ;; - Use a prefix argument (`C-u RET') to open the buffer with
  50. ;; `helm-rg-display-buffer-alternate-method' (which defaults to
  51. ;; `pop-to-buffer').
  52. ;; - The text entered into the minibuffer is interpreted into a PCRE
  53. ;; (https://pcre.org) regexp to pass to `ripgrep'.
  54. ;; - `helm-rg''s pattern syntax is basically PCRE, but single spaces
  55. ;; basically act as a more powerful conjunction operator.
  56. ;; - For example, the pattern `a b' in the minibuffer is transformed
  57. ;; into `a.*b|b.*a'.
  58. ;; - The single space can be used to find lines with any
  59. ;; permutation of the regexps on either side of the space.
  60. ;; - Two spaces in a row will search for a literal single space.
  61. ;; - `ripgrep''s `--smart-case' option is used so that case-sensitive
  62. ;; search is only on if any of the characters in the pattern are capitalized.
  63. ;; - For example, `ab' (conceptually) searches `[Aa][bB]', but `Ab'
  64. ;; in the minibuffer will only search for the pattern `Ab' with `ripgrep',
  65. ;; because it has at least one uppercase letter.
  66. ;; - Use `M-d' to select a new directory to search from.
  67. ;; - Use `M-g' to input a glob pattern to filter files by, e.g. `*.py'.
  68. ;; - The glob pattern defaults to the value of
  69. ;; `helm-rg-default-glob-string', which is an empty string (matches every file)
  70. ;; unless you customize it.
  71. ;; - Pressing `M-g' again shows the same minibuffer prompt for the glob
  72. ;; pattern, with the string that was previously input.
  73. ;; - Use `<left>' and `<right>' to go up and down by files in the results.
  74. ;; - `<up>' and `<down>' simply go up and down by match result, and there
  75. ;; may be many matches for your pattern in a single file, even multiple on a
  76. ;; single line (which `ripgrep' reports as multiple separate results).
  77. ;; - The `<left>' and `<right>' keys will move up or down until it lands on
  78. ;; a result from a different file than it started on.
  79. ;; - When moving by file, `helm-rg' will cycle around the results list,
  80. ;; but it will print a harmless error message instead of looping infinitely if
  81. ;; all results are from the same file.
  82. ;; - Use the interactive autoloaded function `helm-rg-display-help' to see the
  83. ;; ripgrep command's usage info.
  84. ;; TODO:
  85. ;; *items checked completed here are ready to be added to the docs above*
  86. ;; - [x] make a keybinding to drop into an "edit mode" and edit file content
  87. ;; inline in results like `helm-ag' (https://github.com/syohex/emacs-helm-ag)
  88. ;; - *currently called "bounce mode"* in the alpha stage
  89. ;; - [x] needs to dedup results from the same line
  90. ;; - [x] should also merge the colorations
  91. ;; - [x] this might be easier without using the `--vimgrep' flag (!!!)
  92. ;; - [x] can insert markers on either side of each line to find the text
  93. ;; added or removed
  94. ;; - [x] can change the filename by editing the file line
  95. ;; - [x] needs to reset all the file data for each entry if the file
  96. ;; name is being changed!!!
  97. ;; - [x] can expand the windows of text beyond single lines at a time
  98. ;; - using `helm-rg--expand-match-context' and/or
  99. ;; `helm-rg--spread-match-context'
  100. ;; - [x] and pop into another buffer for a quick view if you want
  101. ;; - can use `helm-rg--visit-current-file-for-bounce'
  102. ;; - [ ] can expand up and down from file header lines to add lines
  103. ;; from the top or bottom of the file!
  104. ;; - [ ] can use newlines in inserted text
  105. ;; - not for file names -- newlines are still removed there
  106. ;; - would need to use text properties to move by match results
  107. ;; then, for everything that uses `helm-rg--apply-matches-with-file-for-bounce'
  108. ;; basically
  109. ;; - [x] visiting the file should go to the appropriate line of the file!
  110. ;; - [x] color all results in the file in the async action!
  111. ;; - [x] don't recolor when switching to a different result in the same
  112. ;; file!
  113. ;; - [x] don't color matches whenever file path matches
  114. ;; `helm-rg-shallow-highlight-files-regexp'
  115. ;; - [ ] use `ripgrep' file types instead of flattening globbing out into
  116. ;; `helm-rg-default-glob-string'
  117. ;; - user defines file types in a `defcustom', and can interactively toggle
  118. ;; the accepted file types
  119. ;; - user can also set the default set of file types
  120. ;; - as a dir-local variable!!
  121. ;; - [ ] add testing
  122. ;; - [ ] should be testing all of our interactive functions
  123. ;; - in all configurations (for all permutations of `defcustom' values)
  124. ;; - [ ] also everything that's called by helm
  125. ;; - does helm have any frameworks to make integration testing easier?
  126. ;; - [ ] publish `update-commentary.el' and the associated machinery
  127. ;; - as an npm package, MELPA package, pandoc writer, *???*
  128. ;; - [ ] make a keybinding for running `helm-rg' on dired marked files
  129. ;; - then you could do an `f3' search, bounce to dired, then immediately
  130. ;; `helm-rg' on just the file paths from the `f3' search, *which would be
  131. ;; sick*
  132. ;; License:
  133. ;; GPL 3.0+ (./LICENSE)
  134. ;; End Commentary
  135. ;;; Code:
  136. (require 'ansi-color)
  137. (require 'cl-lib)
  138. (require 'dash)
  139. (require 'font-lock)
  140. (require 'helm)
  141. (require 'helm-files)
  142. (require 'helm-grep)
  143. (require 'helm-lib)
  144. (require 'pcase)
  145. (require 'rx)
  146. (require 'subr-x)
  147. ;; Customization Helpers
  148. (defun helm-rg--always-safe-local (_)
  149. "Use as a :safe predicate in a `defcustom' form to accept any local override."
  150. t)
  151. (defun helm-rg--gen-defcustom-form-from-alist (name alist doc args)
  152. ;; TODO: get all the pcase macros at the very top of the file!
  153. (let ((alist-resolved (pcase-exhaustive alist
  154. ((and (pred symbolp) x) (symbol-value x))
  155. ((and (pred listp) x) x))))
  156. `(defcustom ,name ',(car (helm-rg--alist-keys alist-resolved))
  157. ,doc
  158. :type `(radio ,@(--map `(const ,it) (helm-rg--alist-keys ',alist-resolved)))
  159. :group 'helm-rg
  160. ,@args)))
  161. (defmacro helm-rg--defcustom-from-alist (name alist doc &rest args)
  162. "Create a `defcustom' named NAME which can take the keys of ALIST as values.
  163. The DOC and ARGS are passed on to the generated `defcustom' form. The default value for the
  164. `defcustom' is the `car' of the first element of ALIST. ALIST must be the unquoted name of a
  165. variable containing an alist."
  166. (declare (indent 2))
  167. (helm-rg--gen-defcustom-form-from-alist name alist doc args))
  168. ;; CL deftypes
  169. (cl-deftype helm-rg-existing-file ()
  170. `(and string
  171. (satisfies file-exists-p)))
  172. (cl-deftype helm-rg-existing-directory ()
  173. `(and helm-rg-existing-file
  174. (satisfies file-directory-p)))
  175. ;; Interesting macros
  176. (cl-defmacro helm-rg--with-gensyms ((&rest syms) &rest body)
  177. (declare (indent 1))
  178. `(let ,(--map `(,it (cl-gensym)) syms)
  179. ,@body))
  180. (defmacro helm-rg--_ (expr)
  181. "Replace all instances of `_' in EXPR with an anonymous argument.
  182. Return a lambda accepting that argument."
  183. (declare (debug (sexp body)))
  184. (helm-rg--with-gensyms (arg)
  185. `(lambda (,arg)
  186. ,(cl-subst arg '_ expr :test #'eq))))
  187. (cl-defun helm-rg--join-conditions (conditions &key (joiner 'or))
  188. "If CONDITIONS has one element, return it, otherwise wrap them with JOINER.
  189. This is used because `pcase' doesn't accept conditions with a single element (e.g. `(or 3)')."
  190. (pcase-exhaustive conditions
  191. (`nil (error "The list of conditions may not be nil (with joiner '%S')" joiner))
  192. (`(,single-sexp) single-sexp)
  193. (x `(,joiner ,@x))))
  194. (pcase-defmacro helm-rg-cl-typep (&rest types)
  195. "Matches when the subject is any of TYPES, using `cl-typep'."
  196. (helm-rg--with-gensyms (val)
  197. `(and ,val
  198. ,(helm-rg--join-conditions
  199. (--map `(guard (cl-typep ,val ',it)) types)))))
  200. (pcase-defmacro helm-rg-deref-sym (sym)
  201. "???"
  202. (list 'quote (eval sym)))
  203. (defconst helm-rg--keyword-symbol-rx-expr `(: bos ":"))
  204. (cl-deftype helm-rg-non-keyword-symbol ()
  205. `(and symbol
  206. (not keyword)))
  207. (defun helm-rg--make-non-keyword-sym-from-keyword-sym (kw-sym)
  208. (cl-check-type kw-sym keyword)
  209. (->> kw-sym
  210. (symbol-name)
  211. (replace-regexp-in-string (rx-to-string helm-rg--keyword-symbol-rx-expr) "")
  212. (intern)))
  213. (defun helm-rg--make-keyword-from-non-keyword-sym (non-kw-sym)
  214. (cl-check-type non-kw-sym helm-rg-non-keyword-symbol)
  215. (->> non-kw-sym
  216. (symbol-name)
  217. (format ":%s")
  218. (intern)))
  219. (defun helm-rg--parse-plist-spec (plist-spec)
  220. (pcase-exhaustive plist-spec
  221. (`(,(and (helm-rg-cl-typep keyword) kw-sym)
  222. ,value)
  223. `(,kw-sym ,value))
  224. ((and (helm-rg-cl-typep helm-rg-non-keyword-symbol)
  225. sym)
  226. `(,(helm-rg--make-keyword-from-non-keyword-sym sym)
  227. ,sym))))
  228. (defmacro helm-rg-construct-plist (&rest plist-specs)
  229. (->> plist-specs
  230. (-map #'helm-rg--parse-plist-spec)
  231. (apply #'append '(list))))
  232. (defun helm-rg--parse-&optional-spec (optional-spec)
  233. (pcase-exhaustive optional-spec
  234. (`(,upat ,initform ,svar)
  235. (helm-rg-construct-plist upat initform svar))
  236. (`(,upat ,initform)
  237. (helm-rg-construct-plist upat initform))
  238. ((or `(,upat) upat)
  239. (helm-rg-construct-plist upat))))
  240. (defun helm-rg--read-&optional-specs (parsed-optional-spec-list)
  241. (pcase-exhaustive parsed-optional-spec-list
  242. (`(,cur . ,rest)
  243. `(or (and `nil
  244. ,@(->> (cons cur rest)
  245. (--map (cl-destructuring-bind (&key upat initform svar) it
  246. `(,@(and svar `((let ,svar nil)))
  247. (let ,upat ,initform))))
  248. (funcall #'append)
  249. (-flatten-n 1)))
  250. ,(cl-destructuring-bind (&key upat _initform svar) cur
  251. (helm-rg--join-conditions
  252. ;; FIXME: put the below comment in the docstrings for optional and keyword pcase
  253. ;; macros!
  254. ;; NB: SVAR is bound before INITFORM is evaluated, which means you can refer to SVAR
  255. ;; within INITFORM (and more importantly, within UPAT)!
  256. `(,@(and svar `((let ,svar t)))
  257. ,(->> (and rest
  258. (->> rest
  259. (helm-rg--read-&optional-specs)
  260. (list '\,)))
  261. (cons (list '\, upat))
  262. (list '\`)))
  263. :joiner 'and))))))
  264. (pcase-defmacro helm-rg-&optional (&rest all-optional-specs)
  265. (->> all-optional-specs
  266. (-map #'helm-rg--parse-&optional-spec)
  267. (helm-rg--read-&optional-specs)))
  268. (defun helm-rg--parse-&key-spec (key-spec)
  269. (pcase-exhaustive key-spec
  270. ((and (or :exhaustive :required) special-sym)
  271. special-sym)
  272. (`(,(or `(,(and (helm-rg-cl-typep keyword)
  273. kw-sym)
  274. ,upat)
  275. (and (or `(,upat) upat)
  276. (let kw-sym (helm-rg--make-keyword-from-non-keyword-sym upat))))
  277. . ,(or
  278. (and :required
  279. (let required t)
  280. (let initform nil)
  281. (let svar nil))
  282. (and (helm-rg-&optional initform svar)
  283. (let required nil))))
  284. (helm-rg-construct-plist kw-sym upat required initform svar))
  285. ((and (helm-rg-cl-typep helm-rg-non-keyword-symbol)
  286. upat)
  287. (helm-rg-construct-plist
  288. (:kw-sym (helm-rg--make-keyword-from-non-keyword-sym upat))
  289. upat
  290. (:required nil)
  291. (:initform nil)
  292. (:svar nil)))))
  293. (defun helm-rg--flipped-plist-member (prop plist)
  294. (plist-member plist prop))
  295. (defun helm-rg--plist-parse-pairs (plist)
  296. (cl-loop
  297. with prev-keyword = nil
  298. for el in plist
  299. for is-keyword-posn = t then (not is-keyword-posn)
  300. when is-keyword-posn
  301. do (progn
  302. (cl-check-type el keyword)
  303. (setq prev-keyword el))
  304. else
  305. collect (list prev-keyword el)
  306. into pairs
  307. finally return (progn
  308. (cl-assert (not is-keyword-posn) t
  309. (format "Invalid plist %S ends on keyword '%S'"
  310. plist prev-keyword))
  311. pairs)))
  312. (defun helm-rg--plist-keys (plist)
  313. (->> plist
  314. (helm-rg--plist-parse-pairs)
  315. (-map #'car)))
  316. (defun helm-rg--force-required-parsed-&key-spec (spec)
  317. (cl-destructuring-bind (&key kw-sym upat required initform svar) spec
  318. ;; TODO: better error messaging here!
  319. (cl-assert (not initform))
  320. (cl-assert (not svar))
  321. (cl-assert (not required))
  322. (helm-rg-construct-plist kw-sym upat (:required t) (:initform nil) (:svar nil))))
  323. (cl-defun helm-rg--find-first-duplicate (seq &key (test #'eq))
  324. (cl-loop
  325. with tbl = (make-hash-table :test test)
  326. for el in seq
  327. when (gethash el tbl)
  328. return el
  329. else do (puthash el t tbl)
  330. finally return nil))
  331. (cl-defun helm-rg--read-&key-specs (parsed-key-spec-list &key exhaustive)
  332. (let* ((all-keys (->> parsed-key-spec-list
  333. (--keep (pcase-exhaustive it
  334. (:required nil)
  335. (x (plist-get x :kw-sym))))))
  336. (first-duplicate-key (helm-rg--find-first-duplicate all-keys)))
  337. (when first-duplicate-key
  338. (error "Keyword '%S' provided more than once for keyword set %S"
  339. first-duplicate-key all-keys))
  340. (let ((pcase-expr
  341. (pcase-exhaustive parsed-key-spec-list
  342. (`(:required . ,rest)
  343. (--> rest
  344. (-map #'helm-rg--force-required-parsed-&key-spec it)
  345. (helm-rg--read-&key-specs it)))
  346. (`(,cur . ,rest)
  347. (helm-rg--join-conditions
  348. `(,(helm-rg--join-conditions
  349. (cl-destructuring-bind
  350. (&key kw-sym upat required initform svar) cur
  351. `((app (helm-rg--flipped-plist-member ,kw-sym)
  352. ,(helm-rg--join-conditions
  353. `(,@(unless required
  354. `((and `nil
  355. ,@(and svar `((let ,svar nil)))
  356. (let ,upat ,initform))))
  357. ,(helm-rg--join-conditions
  358. `(,@(and svar `((let ,svar t)))
  359. ;; `plist-member' gives us the rest of the list too -- discard
  360. ;; by matching it to `_'.
  361. ,(->> (list kw-sym (list '\, upat) '\, '_)
  362. (list '\`)))
  363. :joiner 'and))
  364. :joiner 'or))))
  365. :joiner 'and)
  366. ,@(and rest (list (helm-rg--read-&key-specs rest))))
  367. :joiner 'and)))))
  368. (if exhaustive
  369. (helm-rg--with-gensyms (exp-plist-keys)
  370. `(and
  371. ;; NB: we do not attempt to parse the `pcase' subject as a plist (done with
  372. ;; `helm-rg--plist-keys') unless `:exhaustive' is provided (we just use `plist-get')
  373. ;; -- this is intentional.
  374. (and (app (helm-rg--plist-keys) ,exp-plist-keys)
  375. (guard (not (-difference ,exp-plist-keys ',all-keys))))
  376. ,pcase-expr))
  377. pcase-expr))))
  378. (pcase-defmacro helm-rg-&key (&rest all-key-specs)
  379. ;;; TODO: add alist matching -- this should be trivial, just allowing
  380. ;;; non-keyword syms in the argument spec.
  381. (pcase all-key-specs
  382. (`(:exhaustive . ,rest)
  383. (--> rest
  384. (-map #'helm-rg--parse-&key-spec it)
  385. (helm-rg--read-&key-specs it :exhaustive t)))
  386. (specs (->> specs
  387. (-map #'helm-rg--parse-&key-spec)
  388. (helm-rg--read-&key-specs)))))
  389. (pcase-defmacro helm-rg-&key-complete (&rest all-key-specs)
  390. "`helm-rg-&key', but there must be no other keys, and all the keys in ALL-KEY-SPECS must exist."
  391. `(helm-rg-&key :exhaustive :required ,@all-key-specs))
  392. (defun helm-rg--parse-format-spec (format-spec)
  393. "Convert a list FORMAT-SPEC into some result for `helm-rg--make-formatter'."
  394. (pcase-exhaustive format-spec
  395. ((and (helm-rg-cl-typep string) x)
  396. (helm-rg-construct-plist
  397. (:fmt x) (:expr nil) (:argument nil)))
  398. ((and (helm-rg-cl-typep helm-rg-non-keyword-symbol) sym)
  399. (helm-rg-construct-plist (:fmt "%s") (:expr sym) (:argument nil)))
  400. ((and (helm-rg-cl-typep keyword)
  401. (app (helm-rg--make-non-keyword-sym-from-keyword-sym)
  402. non-kw-sym))
  403. (helm-rg-construct-plist (:fmt "%s") (:expr non-kw-sym) (:argument non-kw-sym)))
  404. (`(,(or (and (helm-rg-cl-typep keyword)
  405. (app (helm-rg--make-non-keyword-sym-from-keyword-sym)
  406. argument)
  407. (let expr argument))
  408. (and expr (let argument nil)))
  409. . ,(helm-rg-&key (fmt "%s")))
  410. (helm-rg-construct-plist fmt expr argument))))
  411. (defun helm-rg--read-format-specs (format-spec-list)
  412. (cl-loop
  413. with fmts = nil
  414. with exprs = nil
  415. with arguments = nil
  416. for parsed-spec in (-map #'helm-rg--parse-format-spec format-spec-list)
  417. ;; TODO: turn this into an unzip-plists method/macro or something!
  418. do (cl-destructuring-bind (&key fmt expr argument) parsed-spec
  419. (push fmt fmts)
  420. (when expr (push expr exprs))
  421. (when argument (push argument arguments)))
  422. finally return (helm-rg-construct-plist
  423. (:fmts (reverse fmts))
  424. (:exprs (reverse exprs))
  425. (:arguments (-> arguments (-uniq) (reverse))))))
  426. (cl-defmacro helm-rg-format ((format-specs &rest kwargs) &key (sep " "))
  427. (cl-destructuring-bind (&key fmts exprs arguments)
  428. (helm-rg--read-format-specs format-specs)
  429. (cond
  430. (arguments
  431. `(cl-destructuring-bind (&key ,@arguments) ',kwargs
  432. ;; TODO: a "once-only" macro that's just sugar for gensyms
  433. (format (mapconcat #'identity (list ,@fmts) ,sep) ,@exprs)))
  434. (kwargs
  435. (error "No arguments were declared, but keyword arguments %S were provided" kwargs))
  436. (t
  437. `(format (mapconcat #'identity (list ,@fmts) ,sep) ,@exprs)))))
  438. (cl-defmacro helm-rg-make-formatter (format-specs &key (sep " "))
  439. (cl-destructuring-bind (&key fmts exprs arguments)
  440. (helm-rg--read-format-specs format-specs)
  441. (unless arguments
  442. (error "No arguments were declared in the specs %S" format-specs))
  443. ;; TODO: make a macro that can create a lambda with visible keyword arguments (a "cl-lambda"
  444. ;; type thing)
  445. (helm-rg--with-gensyms (args)
  446. `(lambda (&rest ,args)
  447. (cl-destructuring-bind (&key ,@arguments) ,args
  448. (format (mapconcat #'identity (list ,@fmts) ,sep) ,@exprs))))))
  449. (defun helm-rg--validate-rx-kwarg (keyword-sym-for-binding)
  450. (pcase-exhaustive keyword-sym-for-binding
  451. ((and (helm-rg-cl-typep keyword)
  452. (app (helm-rg--make-non-keyword-sym-from-keyword-sym)
  453. non-kw-sym))
  454. non-kw-sym)
  455. ((and (helm-rg-cl-typep symbol)
  456. non-kw-sym
  457. (app (helm-rg--make-keyword-from-non-keyword-sym)
  458. kw-sym))
  459. (error (helm-rg-format
  460. (("symbol" (non-kw-sym :fmt "%S")
  461. "must be a keyword arg" (kw-sym :fmt "(e.g. %S)."))))))))
  462. (defun helm-rg--apply-tree-fun (mapper tree)
  463. "Apply MAPPER to the nodes of TREE using `-tree-map-nodes'.
  464. This method applies MAPPER, saves the result, and if the result is non-nil, returns the result
  465. instead of the node of MAPPER, otherwise it continues to recurse down the nodes of TREE."
  466. (let (intermediate-value-holder)
  467. (-tree-map-nodes
  468. (helm-rg--_ (setq intermediate-value-holder (funcall mapper _)))
  469. (helm-rg--_ intermediate-value-holder)
  470. tree)))
  471. (defmacro helm-rg--pcase-tree (tree &rest pcase-exprs)
  472. "Apply a `pcase' to the nodes of TREE with `helm-rg--apply-tree-fun'.
  473. PCASE-EXPRS are the cases provided to `pcase'. If the `pcase' cases do not
  474. match the node (returns nil), it continues to recurse down the tree --
  475. otherwise, the return value replaces the node of the tree."
  476. (declare (indent 1))
  477. `(helm-rg--apply-tree-fun
  478. (helm-rg--_ (pcase _ ,@pcase-exprs))
  479. ,tree))
  480. (defconst helm-rg--named-group-symbol 'named-group)
  481. (defconst helm-rg--eval-expr-symbol 'eval)
  482. (defconst helm-rg--duplicate-var-eval-form-error-str
  483. "'%S' variable name used a second time in evaluation of form '%S'.
  484. previous vars were: %S")
  485. (defconst helm-rg--duplicate-var-literal-form-error-str
  486. "'%S' variable named used a second time in declaration of regexp group '%S'.
  487. previous vars were: %S")
  488. (cl-defun helm-rg--transform-rx-sexp (sexp &key (group-num-init 1))
  489. (let ((all-bind-vars-mappings nil))
  490. (--> (helm-rg--pcase-tree sexp
  491. ;; `(eval ,eval-expr) => evaluate the expression!
  492. ;; NB: this occurs at macro-expansion time, like the equivalent `rx'
  493. ;; pcase macro, which is before any surrounding let-bindings occur!)
  494. (`(,(helm-rg-deref-sym helm-rg--eval-expr-symbol) ,eval-expr)
  495. (cl-destructuring-bind (&key transformed bind-vars)
  496. (helm-rg--transform-rx-sexp (eval eval-expr t) :group-num-init group-num-init)
  497. (cl-loop
  498. for quoted-var in bind-vars
  499. do (progn
  500. (cl-incf group-num-init)
  501. (when (cl-find quoted-var all-bind-vars-mappings)
  502. (error helm-rg--duplicate-var-eval-form-error-str
  503. quoted-var eval-expr all-bind-vars-mappings))
  504. (push quoted-var all-bind-vars-mappings)))
  505. transformed))
  506. ;; `(named-group :var-name . ,rx-forms) => create an explicitly-numbered regexp group
  507. ;; and, if the resulting regexp matches, bind the match string for that numbered group to
  508. ;; var-name (without the initial ":", which is required)!
  509. (`(,(helm-rg-deref-sym helm-rg--named-group-symbol)
  510. ,(app (helm-rg--validate-rx-kwarg) binding-var)
  511. . ,rx-forms)
  512. ;; We have bound to this variable -- save the current group number and push this
  513. ;; variable onto the list of binding variables.
  514. (let ((cur-group-num group-num-init))
  515. (push binding-var all-bind-vars-mappings)
  516. (cl-incf group-num-init)
  517. (cl-loop
  518. for sub-rx in rx-forms
  519. collect (cl-destructuring-bind (&key transformed bind-vars)
  520. (helm-rg--transform-rx-sexp sub-rx :group-num-init group-num-init)
  521. (cl-loop
  522. for quoted-var in bind-vars
  523. do (progn
  524. (cl-incf group-num-init)
  525. (when (cl-find quoted-var all-bind-vars-mappings)
  526. (error
  527. helm-rg--duplicate-var-literal-form-error-str
  528. quoted-var sub-rx all-bind-vars-mappings))
  529. (push quoted-var all-bind-vars-mappings)))
  530. transformed)
  531. into all-transformed-exprs
  532. finally return `(group-n ,cur-group-num ,@all-transformed-exprs)))))
  533. (list :transformed it :bind-vars (reverse all-bind-vars-mappings)))))
  534. (defmacro helm-rg-pcase-cl-defmacro (&rest args)
  535. "`pcase-defmacro', but the --pcase-macroexpander function is a `cl-defun'.
  536. \n(fn NAME ARGS [DOC] &rest BODY...)"
  537. (declare (indent 2) (debug defun) (doc-string 3))
  538. (->> `(pcase-defmacro ,@args)
  539. (macroexpand-1)
  540. (cl-subst 'cl-defun 'defun)))
  541. (helm-rg-pcase-cl-defmacro helm-rg-rx (rx-sexp)
  542. ;; FIXME: have some way to get the indices of each bound var (for things like
  543. ;; `match-data')
  544. (pcase-exhaustive (helm-rg--transform-rx-sexp rx-sexp)
  545. ((helm-rg-&key-complete transformed bind-vars)
  546. (helm-rg--with-gensyms (str-sym)
  547. `(and ,str-sym
  548. ,(helm-rg--join-conditions
  549. ;; We would just delegate to `rx--pcase-macroexpander', but requiring subr errors
  550. ;; out, extremely mysteriously.
  551. `((pred (string-match (rx-to-string ',transformed)))
  552. ,@(cl-loop for symbol-to-bind in bind-vars
  553. for match-index upfrom 1
  554. collect `(let ,symbol-to-bind (match-string ,match-index ,str-sym))))
  555. :joiner 'and))))))
  556. (defun helm-rg--prefix-symbol-with-underscore (sym)
  557. (->> sym
  558. (symbol-name)
  559. (format "_%s")
  560. (intern)))
  561. (defmacro helm-rg-mark-unused (vars &rest body)
  562. (declare (indent 1))
  563. `(let (,@(--map `(,(helm-rg--prefix-symbol-with-underscore it) ,it) vars))
  564. ,@body))
  565. ;; Public error types
  566. (define-error 'helm-rg-error "Error invoking `helm-rg'")
  567. ;; Customization
  568. (defgroup helm-rg nil
  569. "Group for `helm-rg' customizations."
  570. :group 'helm-grep)
  571. (defcustom helm-rg-ripgrep-executable (executable-find "rg")
  572. "The location of the ripgrep binary executable."
  573. :type 'string
  574. :group 'helm-rg)
  575. (defcustom helm-rg-default-glob-string ""
  576. "The glob pattern used for the '-g' argument to ripgrep.
  577. Set to the empty string to match every file."
  578. :type 'string
  579. :safe #'helm-rg--always-safe-local
  580. :group 'helm-rg)
  581. (defcustom helm-rg-default-extra-args nil
  582. "Extra arguments passed to ripgrep on the command line.
  583. Note that default filename globbing and case sensitivity can be set with their own defcustoms, and
  584. can be modified while invoking `helm-rg' -- see the help for that method. If the extra arguments are
  585. ones you use commonly, consider submitting a pull request to
  586. https://github.com/cosmicexplorer/helm-rg with a specific `defcustom' and keybinding for that
  587. particular ripgrep option and set of options."
  588. :type '(repeat string)
  589. :safe #'helm-rg--always-safe-local
  590. :group 'helm-rg)
  591. (defcustom helm-rg-default-directory 'default
  592. "Specification for starting directory to invoke ripgrep in.
  593. Used in `helm-rg--interpret-starting-dir'. Possible values:
  594. 'default => Use `default-directory'.
  595. 'git-root => Use \"git rev-parse --show-toplevel\" (see
  596. `helm-rg-git-executable').
  597. <string> => Use the directory at path <string>."
  598. :type '(choice symbol string)
  599. :safe #'helm-rg--always-safe-local
  600. :group 'helm-rg)
  601. (defcustom helm-rg-git-executable (executable-find "git")
  602. "Location of git executable."
  603. :type 'string
  604. :group 'helm-rg)
  605. (defcustom helm-rg-thing-at-point 'symbol
  606. "Type of object at point to initialize the `helm-rg' minibuffer input with."
  607. :type 'symbol
  608. :safe #'helm-rg--always-safe-local
  609. :group 'helm-rg)
  610. (defcustom helm-rg-input-min-search-chars 2
  611. "Ripgrep will not be invoked unless the input is at least this many chars.
  612. See `helm-rg--make-process' and `helm-rg--make-dummy-process' if interested."
  613. ;; FIXME: this should be a *positive* integer!
  614. :type 'integer
  615. :safe #'helm-rg--always-safe-local
  616. :group 'helm-rg)
  617. (defcustom helm-rg-display-buffer-normal-method #'switch-to-buffer
  618. "A function accepting a single argument BUF and displaying the buffer.
  619. The default function to invoke to display a visited buffer in some window in
  620. `helm-rg'."
  621. :type 'function
  622. :group 'helm-rg)
  623. (defcustom helm-rg-display-buffer-alternate-method #'pop-to-buffer
  624. "A function accepting a single argument BUF and displaying the buffer.
  625. The function will be invoked if a prefix argument is used when visiting a result
  626. in `helm-rg'."
  627. :type 'function
  628. :group 'helm-rg)
  629. (defcustom helm-rg-shallow-highlight-files-regexp nil
  630. "Regexp describing file paths to only partially highlight, for performance reasons.
  631. By default, `helm-rg' will create overlays to highlight all the matches from ripgrep in a file when
  632. previewing a result. This is done each time a match is selected, even for buffers already
  633. previewed. Creating these overlays can be slow for files with lots of matches in some search. If
  634. this variable is set to an elisp regexp and some file path matches it, `helm-rg' will only highlight
  635. the current line of the file and the matches in that line when previewing that file."
  636. :type 'regexp
  637. :safe #'helm-rg--always-safe-local
  638. :group 'helm-rg)
  639. (defcustom helm-rg-prepend-file-name-line-at-top-of-matches t
  640. "Whether to put the file path as a separate line in `helm-rg' output above the file's matches.
  641. The file can be visited as if it was a match on the first line of the file (without any matched
  642. text).
  643. FIXME: if this is nil and `helm-rg-include-file-on-every-match-line' is t, you get a stream of just
  644. line numbers and content, without any file names. We should unify these two boolean options somehow
  645. to get all three allowable states."
  646. :type 'boolean
  647. :group 'helm-rg)
  648. (defcustom helm-rg-include-file-on-every-match-line nil
  649. "Whether to include the file path on every line of `helm-rg' output.
  650. This is purely an interface change, and does not affect anything else."
  651. :type 'boolean
  652. :group 'helm-rg)
  653. (defcustom helm-rg--default-expand-match-lines-for-bounce 3
  654. "???"
  655. ;; FIXME: this should be a *positive* integer!
  656. :type 'integer
  657. :group 'helm-rg)
  658. ;; Faces
  659. (defface helm-rg-preview-line-highlight
  660. '((t (:background "green" :foreground "black")))
  661. "Face for the line of text matched by the ripgrep process."
  662. :group 'helm-rg)
  663. (defface helm-rg-base-rg-cmd-face
  664. '((t (:foreground "gray" :weight normal)))
  665. "Face for the ripgrep executable in the ripgrep invocation."
  666. :group 'helm-rg)
  667. (defface helm-rg-extra-arg-face
  668. '((t (:foreground "yellow" :weight normal)))
  669. "Face for any arguments added to the command line through `helm-rg--extra-args'."
  670. :group 'helm-rg)
  671. (defface helm-rg-inactive-arg-face
  672. '((t (:foreground "gray" :weight normal)))
  673. "Face for non-essential arguments in the ripgrep invocation."
  674. :group 'helm-rg)
  675. (defface helm-rg-active-arg-face
  676. '((t (:foreground "green")))
  677. "Face for arguments in the ripgrep invocation which affect the results."
  678. :group 'helm-rg)
  679. (defface helm-rg-directory-cmd-face
  680. '((t (:foreground "brown" :background "black" :weight normal)))
  681. "Face for any directories provided as paths to the ripgrep invocation.")
  682. (defface helm-rg-error-message
  683. '((t (:foreground "red")))
  684. "Face for error text displayed in the `helm-buffer' for `helm-rg'."
  685. :group 'helm-rg)
  686. (defface helm-rg-title-face
  687. '((t (:foreground "purple" :background "black" :weight bold)))
  688. "Face for the title of the ripgrep async helm source."
  689. :group 'helm-rg)
  690. (defface helm-rg-directory-header-face
  691. '((t (:foreground "white" :background "black" :weight bold)))
  692. "Face for the current directory in the header of the `helm-buffer' for `helm-rg'."
  693. :group 'helm-rg)
  694. (defface helm-rg-file-match-face
  695. '((t (:foreground "#0ff" :underline t)))
  696. "Face for the file name when displaying matches in the `helm-buffer' for `helm-rg'."
  697. :group 'helm-rg)
  698. (defface helm-rg-colon-separator-ripgrep-output-face
  699. '((t (:foreground "white")))
  700. "Face for the separator between file, line, and match text in ripgrep output."
  701. :group 'helm-rg)
  702. (defface helm-rg-line-number-match-face
  703. '((t (:foreground "orange" :underline t)))
  704. "Face for line numbers when displaying matches in the `helm-buffer' for `helm-rg'."
  705. :group 'helm-rg)
  706. (defface helm-rg-match-text-face
  707. '((t (:foreground "white" :background "purple")))
  708. "Face for displaying matches in the `helm-buffer' and in file previews for `helm-rg'."
  709. :group 'helm-rg)
  710. ;; Constants
  711. (defconst helm-rg--color-format-argument-alist
  712. '((red :cmd-line "red" :text-property "red3"))
  713. "Alist mapping symbols to color descriptions.
  714. This alist mapps (a symbol named after a color) -> (strings to describe that symbol on the ripgrep
  715. command line and in an Emacs text property). This allows `helm-rg' to identify matched text using
  716. ripgrep's highlighted output directly instead of doing it ourselves, by telling ripgrep to highlight
  717. matches a specific color, then searching for that specific color as a text property in the output.")
  718. (defconst helm-rg--style-format-argument-alist
  719. '((bold :cmd-line "bold" :text-property bold))
  720. "Very similar to `helm-rg--color-format-argument-alist', but for non-color styling.")
  721. (defconst helm-rg--case-sensitive-argument-alist
  722. '((smart-case "--smart-case")
  723. (case-sensitive "--case-sensitive")
  724. (case-insensitive "--ignore-case"))
  725. "Alist of methods of treating case-sensitivity when invoking ripgrep.
  726. The value is the ripgrep command line argument which enforces the specified type of
  727. case-sensitivity.")
  728. (defconst helm-rg--ripgrep-argv-format-alist
  729. `((helm-rg-ripgrep-executable :face helm-rg-base-rg-cmd-face)
  730. ((->> helm-rg--case-sensitive-argument-alist
  731. (helm-rg--alist-get-exhaustive helm-rg--case-sensitivity))
  732. :face helm-rg-active-arg-face)
  733. ("--color=ansi" :face helm-rg-inactive-arg-face)
  734. ((helm-rg--construct-match-color-format-arguments)
  735. :face helm-rg-inactive-arg-face)
  736. ((unless (helm-rg--empty-glob-p helm-rg--glob-string)
  737. (list "-g" helm-rg--glob-string))
  738. :face helm-rg-active-arg-face)
  739. (helm-rg--extra-args :face helm-rg-extra-arg-face)
  740. (it
  741. :face font-lock-string-face)
  742. ((helm-rg--process-paths-to-search helm-rg--paths-to-search)
  743. :face helm-rg-directory-cmd-face))
  744. "Alist mapping (sexp -> face) describing how to generate and propertize the argv for ripgrep.")
  745. (defconst helm-rg--helm-buffer-name "*helm-rg*")
  746. (defconst helm-rg--process-name "*helm-rg--rg*")
  747. (defconst helm-rg--process-buffer-name "*helm-rg--rg-output*")
  748. (defconst helm-rg--error-process-name "*helm-rg--error-process*")
  749. (defconst helm-rg--error-buffer-name "*helm-rg--errors*")
  750. (defconst helm-rg--ripgrep-help-buffer-name "helm-rg-usage-help")
  751. (defconst helm-rg--bounce-buffer-name "helm-rg-bounce-buf")
  752. (defconst helm-rg--output-new-file-line-rx-expr
  753. `(named-group
  754. :whole-line
  755. (: bos
  756. (named-group :file-path (+? (not (any 0))))
  757. eos))
  758. "Regexp for ripgrep output which marks the start of results for a new file.
  759. See `helm-rg--process-transition' for usage.")
  760. (defconst helm-rg--numbered-text-line-rx-expr
  761. `(named-group
  762. :whole-line
  763. (: bos
  764. (named-group :line-num-str (+ digit))
  765. ":"
  766. (named-group :content (*? anything))
  767. eos))
  768. "Regexp for ripgrep output which marks a matched line, with the line number and content.
  769. See `helm-rg--process-transition' for usage.")
  770. (defconst helm-rg--persistent-action-display-buffer-method #'switch-to-buffer
  771. "A function accepting a single argument BUF and displaying the buffer.
  772. Let-bound to `helm-rg--display-buffer-method' in `helm-rg--async-persistent-action'.")
  773. (defconst helm-rg--loop-input-pattern-regexp
  774. (rx
  775. (:
  776. (* (char ? ))
  777. ;; group 1 = single entire element
  778. (group
  779. (+
  780. (|
  781. (not (in ? ))
  782. (= 2 ? ))))))
  783. "Regexp applied iteratively to split the input interpreted by `helm-rg'.")
  784. (defconst helm-rg--all-whitespace-regexp
  785. (rx (: bos (zero-or-more space) eos)))
  786. (defconst helm-rg--jump-location-text-property 'helm-rg-jump-to
  787. "Name of a text property attached to the colorized ripgrep output.
  788. This text property contains location and match info. See `helm-rg--process-transition' for usage.")
  789. (defconst helm-rg--helm-header-property-name 'helm-header
  790. "Property used for the \"header\" of the `helm-buffer' displayed in `helm-rg'.
  791. This header is generated by helm, and is separate from the process output.")
  792. ;; Variables
  793. (defvar helm-rg--append-persistent-buffers nil
  794. "Whether to record buffers opened during an `helm-rg' session.")
  795. (defvar helm-rg--cur-persistent-bufs nil
  796. "List of buffers opened temporarily during an `helm-rg' session.")
  797. (defvar helm-rg--matches-in-current-file-overlays nil
  798. "List of overlays used to highlight matches in `helm-rg'.")
  799. (defvar helm-rg--current-line-overlay nil
  800. "Overlay for highlighting the selected matching line in a file in `helm-rg'.")
  801. (defvar helm-rg--current-dir nil
  802. "Working directory for the current `helm-rg' session.")
  803. (defvar helm-rg--last-dir nil
  804. "Last used working directory for resume.")
  805. (defvar helm-rg--glob-string nil
  806. "Glob string used for the current `helm-rg' session.")
  807. (defvar helm-rg--glob-string-history nil
  808. "History variable for the selection of `helm-rg--glob-string'.")
  809. (defvar helm-rg--extra-args nil
  810. "Arguments not associated with other `helm-rg' options, added to the ripgrep command line.")
  811. (defvar helm-rg--extra-args-history nil
  812. "History variable for the selection of `helm-rg--extra-args'.")
  813. (defvar helm-rg--input-history nil
  814. "History variable for the pattern input to the ripgrep process.")
  815. (defvar helm-rg--display-buffer-method nil
  816. "The method to use to display a buffer visiting a result.
  817. Should accept one argument BUF, the buffer to display.")
  818. (defvar helm-rg--paths-to-search nil
  819. ;; FIXME: we have multiple `defvar's which just mirror `defcustoms' (and can then be toggled while
  820. ;; searching) -- we should almost definitely have a macro to declare/access these kinds of
  821. ;; variables uniformly.
  822. "List of paths to use in the ripgrep command.
  823. All paths are interpreted relative to the directory ripgrep is invoked from.
  824. When nil, searches from the directory ripgrep is invoked from.
  825. See the documentation for `helm-rg-default-directory'.")
  826. (defvar helm-rg--case-sensitivity nil
  827. "Key of `helm-rg--case-sensitive-argument-alist' to use in a `helm-rg' session.")
  828. (defvar helm-rg--previously-highlighted-buffer nil
  829. "Previous buffer visited in between async actions of a `helm-rg' session.
  830. Used to cache the overlays drawn for matches within a file when visiting matches in the same file
  831. using `helm-rg--async-persistent-action'.")
  832. (defvar helm-rg--last-argv nil
  833. "Argument list for the most recent ripgrep invocation.
  834. Used for the command line header in `helm-rg--bounce-mode'.")
  835. ;; Buffer-local Variables
  836. (defvar-local helm-rg--process-output-parse-state
  837. (list :cur-file nil)
  838. "Contains state which is updated as the ripgrep output is processed.
  839. This is buffer-local because it is specific to a single process invocation and is manipulated in
  840. that process's buffer. See `helm-rg--parse-process-output' for usage.")
  841. (defvar-local helm-rg--beginning-of-bounce-content-mark nil
  842. "Contains a marker pointing to the beginning of the match results in a `helm-rg--bounce' buffer.")
  843. (defvar-local helm-rg--do-font-locking nil
  844. "If t, colorize the file text as it would be in an editor.
  845. This may be expensive for larger files, so it is turned off if
  846. `helm-rg-shallow-highlight-files-regexp' is a regexp matching the file's path.")
  847. ;; Utilities
  848. (defun helm-rg--alist-get-exhaustive (key alist)
  849. "Get KEY from ALIST, or throw an error."
  850. (or (alist-get key alist)
  851. (error "Key '%s' was not found in alist '%S' during an exhaustiveness check"
  852. key alist)))
  853. (defun helm-rg--alist-keys (alist)
  854. "Get all keys of ALIST."
  855. (cl-mapcar #'car alist))
  856. (defmacro helm-rg--get-optional-typed (type-name obj &rest body)
  857. "If OBJ is non-nil, check its type against TYPE-NAME, then bind it to `it' and execute BODY."
  858. (declare (indent 2))
  859. `(let ((it ,obj))
  860. (when it
  861. (cl-check-type it ,type-name)
  862. ,@body)))
  863. (defmacro helm-rg--into-temp-buffer (to-insert &rest body)
  864. "Execute BODY at the beginning of a `with-temp-buffer' containing TO-INSERT."
  865. (declare (indent 1))
  866. `(with-temp-buffer
  867. (insert ,to-insert)
  868. (goto-char (point-min))
  869. ,@body))
  870. (defmacro helm-rg--with-named-temp-buffer (name &rest body)
  871. "Execute BODY after binding the result of a `with-temp-buffer' to NAME.
  872. BODY is executed in the original buffer, not the new temp buffer."
  873. (declare (indent 1))
  874. (let ((cur-buf (cl-gensym "helm-rg--with-named-temp-buffer")))
  875. `(let ((,cur-buf (current-buffer)))
  876. (with-temp-buffer
  877. (let ((,name (current-buffer)))
  878. (with-current-buffer ,cur-buf
  879. ,@body))))))
  880. ;; Logic
  881. (defun helm-rg--make-dummy-process (input err-msg)
  882. "Make a process that immediately exits to display just a title.
  883. Provide INPUT to represent the `helm-pattern', and ERR-MSG as the reasoning for failing to display
  884. any results."
  885. (let* ((dummy-proc (make-process
  886. :name helm-rg--process-name
  887. :buffer helm-rg--process-buffer-name
  888. :command '("echo")
  889. :noquery t))
  890. (input-repr
  891. (cond
  892. ((string= input "")
  893. "<empty string>")
  894. ((string-match-p helm-rg--all-whitespace-regexp input)
  895. "<whitespace>")
  896. (t input)))
  897. (helm-src-name
  898. (format "%s %s: %s"
  899. (helm-rg--make-face 'helm-rg-error-message "no results for input")
  900. (helm-rg--make-face 'font-lock-string-face input-repr)
  901. (helm-rg--make-face 'helm-rg-error-message err-msg))))
  902. (helm-attrset 'name helm-src-name)
  903. dummy-proc))
  904. (defun helm-rg--validate-or-make-dummy-process (input)
  905. (cond
  906. ((< (length input) helm-rg-input-min-search-chars)
  907. (helm-rg--make-dummy-process
  908. input
  909. (format "must be at least %d characters" helm-rg-input-min-search-chars)))
  910. (t t)))
  911. (defun helm-rg--join (sep seq)
  912. (mapconcat #'identity seq sep))
  913. (defun helm-rg--props (props str)
  914. (apply #'propertize (append (list str) props)))
  915. (defun helm-rg--make-face (face str)
  916. (helm-rg--props `(face ,face) str))
  917. (defun helm-rg--process-paths-to-search (paths)
  918. (cl-check-type helm-rg--current-dir helm-rg-existing-directory)
  919. (cl-loop
  920. for path in paths
  921. for expanded = (expand-file-name path helm-rg--current-dir)
  922. unless (file-exists-p expanded)
  923. do (error (concat "Error: expanded path '%s' does not exist. "
  924. "The cwd was '%s', and the paths provided were %S.")
  925. expanded
  926. helm-rg--current-dir
  927. paths)
  928. ;; TODO: a `pcase-defmacro' or `pcase' wrapper which checks that all possible cases of a
  929. ;; `helm-rg--defcustom-from-alist' are enumerated at compile time!
  930. ;; TODO: `helm-resume' currently fails on resume in the 'relative case.
  931. collect (pcase-exhaustive helm-rg-file-paths-in-matches-behavior
  932. (`relative (file-relative-name expanded helm-rg--current-dir))
  933. (`absolute expanded))))
  934. (defun helm-rg--empty-glob-p (glob-str)
  935. (or (null glob-str)
  936. (string-blank-p glob-str)))
  937. (defun helm-rg--construct-argv (pattern)
  938. "Create an argument list from the `helm-pattern' PATTERN for the ripgrep command.
  939. This argument list is propertized for display in the `helm-buffer' header when using `helm-rg', and
  940. is used directly to invoke ripgrep. It uses `defcustom' values, and `defvar' values bound in other
  941. functions."
  942. ;; TODO: document these pcase deconstructions in the docstring for
  943. ;; `helm-rg--ripgrep-argv-format-alist'!
  944. (cl-loop
  945. for el in helm-rg--ripgrep-argv-format-alist
  946. append (pcase-exhaustive el
  947. (`(,(or (and `it (let expr pattern)) expr) :face ,face-sym)
  948. (pcase-exhaustive (eval expr)
  949. ((and (pred listp) args)
  950. (--map (helm-rg--make-face face-sym it) args))
  951. (arg
  952. (list (helm-rg--make-face face-sym arg))))))))
  953. (defun helm-rg--make-process-from-argv (argv)
  954. (let* ((real-proc (make-process
  955. :name helm-rg--process-name
  956. :buffer helm-rg--process-buffer-name
  957. :command argv
  958. :noquery t))
  959. (helm-src-name
  960. (format "argv: %s" (helm-rg--join " " argv))))
  961. (helm-attrset 'name helm-src-name)
  962. (set-process-query-on-exit-flag real-proc nil)
  963. real-proc))
  964. (defun helm-rg--make-process ()
  965. "Invoke ripgrep in `helm-rg--current-dir' with `helm-pattern'.
  966. Make a dummy process if the input is empty with a clear message to the user."
  967. (let* ((default-directory helm-rg--current-dir)
  968. (input helm-pattern))
  969. (pcase-exhaustive (helm-rg--validate-or-make-dummy-process input)
  970. ((and (pred processp) x)
  971. (setq helm-rg--last-argv nil)
  972. x)
  973. (`t
  974. (let* ((rg-regexp (helm-rg--helm-pattern-to-ripgrep-regexp input))
  975. (argv (helm-rg--construct-argv rg-regexp))
  976. (real-proc (helm-rg--make-process-from-argv argv)))
  977. (setq helm-rg--last-argv argv)
  978. real-proc)))))
  979. (defun helm-rg--make-overlay-with-face (beg end face)
  980. "Generate an overlay in region BEG to END with face FACE."
  981. (let ((olay (make-overlay beg end)))
  982. (overlay-put olay 'face face)
  983. olay))
  984. (defun helm-rg--delete-match-overlays ()
  985. "Delete all cached overlays in `helm-rg--matches-in-current-file-overlays', and clear it."
  986. (mapc #'delete-overlay helm-rg--matches-in-current-file-overlays)
  987. (setq helm-rg--matches-in-current-file-overlays nil))
  988. (defun helm-rg--delete-line-overlay ()
  989. "Delete the cached overlay `helm-rg--current-line-overlay', if it exists, and clear it."
  990. (helm-rg--get-optional-typed overlay helm-rg--current-line-overlay
  991. (delete-overlay it))
  992. (setq helm-rg--current-line-overlay nil))
  993. (defun helm-rg--collect-lines-matches-current-file (orig-line-parsed)
  994. "Collect all of the matched text regions from ripgrep's highlighted output from ORIG-LINE-PARSED."
  995. ;; If we are on a file's line, stay where we are, otherwise back up to the closest file line above
  996. ;; the current line (this is the file that "owns" the entry).
  997. (cl-destructuring-bind (&key
  998. ((:file orig-file))
  999. ((:line-num _orig-line-num))
  1000. ((:match-results _orig-match-results)))
  1001. orig-line-parsed
  1002. ;; Collect all the results on all matching lines of the file.
  1003. (with-helm-window
  1004. (helm-rg--file-backward t)
  1005. (let ((all-match-results nil))
  1006. ;; Process the first line (`helm-rg--iterate-results' will advance
  1007. ;; past the initial element).
  1008. (cl-destructuring-bind (&key _file line-num match-results) (helm-rg--current-jump-location)
  1009. (when (and line-num match-results)
  1010. (push (list :match-line-num line-num
  1011. :line-match-results match-results)
  1012. all-match-results)))
  1013. (helm-rg--iterate-results
  1014. 'forward
  1015. :success-fn (lambda (cur-line-parsed)
  1016. (cl-destructuring-bind (&key file line-num match-results)
  1017. cur-line-parsed
  1018. (cl-check-type orig-file string)
  1019. (cl-check-type file string)
  1020. (if (not (string= orig-file file))
  1021. ;; We have reached the results from a different file, so done.
  1022. t
  1023. (progn
  1024. ;; In filename lines, these are nil.
  1025. (when (and line-num match-results)
  1026. (push (list :match-line-num line-num
  1027. :line-match-results match-results)
  1028. all-match-results))
  1029. ;; We loop forever if there's only one file in
  1030. ;; the results unless we return this as success.
  1031. (helm-end-of-source-p)))))
  1032. :failure-fn (lambda (cur-line-parsed)
  1033. (helm-rg--different-file-line orig-line-parsed cur-line-parsed)))
  1034. (helm-rg--iterate-results
  1035. 'backward
  1036. :success-fn (lambda (cur-line-pars