branch: externals/consult
commit 53e78c6be5c64f9fdeb61c55cbec9a4f56f46adc
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
consult-grep/git-grep/ripgrep: Add -F, --fixed-strings support (Fix #608)
---
CHANGELOG.org | 1 +
consult.el | 108 ++++++++++++++++++++++++++++++++--------------------------
2 files changed, 61 insertions(+), 48 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 907ac4851e..b1c3103e30 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -7,6 +7,7 @@
- Bugfixes
- Allow =consult-flymake= to work across all buffers in a project
- Remove deprecated =consult-completing-read-multiple=
+- =consult-grep/git-grep/ripgrep=: Add =--fixed-strings= support
* Version 0.18 (2022-05-25)
diff --git a/consult.el b/consult.el
index e37641fcd7..fe6f252244 100644
--- a/consult.el
+++ b/consult.el
@@ -547,21 +547,23 @@ pairs."
;; split-string-and-unquote fails if the quotes are invalid. Ignore it.
(cons str (and opts (ignore-errors (split-string-and-unquote opts)))))))
-(defun consult--highlight-regexps (regexps str)
+(defun consult--highlight-regexps (regexps ignore-case str)
"Highlight REGEXPS in STR.
If a regular expression contains capturing groups, only these are highlighted.
-If no capturing groups are used highlight the whole match."
- (dolist (re regexps)
- (when (string-match re str)
- ;; Unfortunately there is no way to avoid the allocation of the match
- ;; data, since the number of capturing groups is unknown.
- (let ((m (match-data)))
- (setq m (or (cddr m) m))
- (while m
- (when (car m)
- (add-face-text-property (car m) (cadr m)
- 'consult-preview-match nil str))
- (setq m (cddr m)))))))
+If no capturing groups are used highlight the whole match. Case is ignored
+if IGNORE-CASE is non-nil."
+ (let ((case-fold-search ignore-case))
+ (dolist (re regexps)
+ (when (string-match re str)
+ ;; Unfortunately there is no way to avoid the allocation of the match
+ ;; data, since the number of capturing groups is unknown.
+ (let ((m (match-data)))
+ (setq m (or (cddr m) m))
+ (while m
+ (when (car m)
+ (add-face-text-property (car m) (cadr m)
+ 'consult-preview-match nil str))
+ (setq m (cddr m))))))))
(defconst consult--convert-regexp-table
(append
@@ -619,9 +621,7 @@ matches case insensitively."
(setq input (consult--split-escaped input))
(cons (mapcar (lambda (x) (consult--convert-regexp x type)) input)
(when-let (regexps (seq-filter #'consult--valid-regexp-p input))
- (lambda (str)
- (let ((case-fold-search ignore-case))
- (consult--highlight-regexps regexps str))))))
+ (apply-partially #'consult--highlight-regexps regexps ignore-case))))
(defun consult--split-escaped (str)
"Split STR at spaces, which can be escaped with backslash."
@@ -4386,17 +4386,22 @@ INITIAL is inital input."
(defun consult--grep-builder (input)
"Build command line given INPUT."
(pcase-let* ((cmd (split-string-and-unquote consult-grep-args))
- (type (consult--grep-regexp-type (car cmd)))
(`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type
- (member "--ignore-case" cmd))))
- (when re
- (list :command
- (append cmd
- (list (if (eq type 'pcre) "--perl-regexp"
"--extended-regexp")
- "-e" (consult--join-regexps re type))
- opts)
- :highlight hl))))
+ (flags (append cmd opts))
+ (ignore-case (or (member "-i" flags) (member "--ignore-case"
flags))))
+ (if (or (member "-F" flags) (member "--fixed-strings" flags))
+ `(:command (,@cmd "-e" ,arg ,@opts) :highlight
+ ,(apply-partially #'consult--highlight-regexps
+ (list (regexp-quote arg)) ignore-case))
+ (pcase-let* ((type (consult--grep-regexp-type (car cmd)))
+ (`(,re . ,hl) (funcall consult--regexp-compiler arg type
ignore-case)))
+ (when re
+ `(:command
+ (,@cmd
+ ,(if (eq type 'pcre) "--perl-regexp" "--extended-regexp")
+ "-e" ,(consult--join-regexps re type)
+ ,@opts)
+ :highlight ,hl))))))
;;;###autoload
(defun consult-grep (&optional dir initial)
@@ -4445,14 +4450,17 @@ Otherwise the `default-directory' is searched."
"Build command line given CONFIG and INPUT."
(pcase-let* ((cmd (split-string-and-unquote consult-git-grep-args))
(`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended
- (member "--ignore-case" cmd))))
- (when re
- (list :command
- (append cmd
- (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re))
- opts)
- :highlight hl))))
+ (flags (append cmd opts))
+ (ignore-case (or (member "-i" flags) (member "--ignore-case"
flags))))
+ (if (or (member "-F" flags) (member "--fixed-strings" flags))
+ `(:command (,@cmd "-e" ,arg ,@opts) :highlight
+ ,(apply-partially #'consult--highlight-regexps
+ (list (regexp-quote arg)) ignore-case))
+ (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg
'extended ignore-case)))
+ (when re
+ `(:command
+ (,@cmd ,@(cdr (mapcan (lambda (x) (list "--and" "-e" x)) re))
,@opts)
+ :highlight ,hl))))))
;;;###autoload
(defun consult-git-grep (&optional dir initial)
@@ -4474,21 +4482,25 @@ for more details."
(defun consult--ripgrep-builder (input)
"Build command line given INPUT."
(pcase-let* ((cmd (split-string-and-unquote consult-ripgrep-args))
- (type (consult--ripgrep-regexp-type (car cmd)))
(`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type
- (if (member "--smart-case" cmd)
- (let ((case-fold-search nil))
- ;; Case insensitive if there are no
uppercase letters
- (not (string-match-p "[[:upper:]]"
input)))
- (member "--ignore-case" cmd)))))
- (when re
- (list :command
- (append cmd
- (and (eq type 'pcre) '("-P"))
- (list "-e" (consult--join-regexps re type))
- opts)
- :highlight hl))))
+ (flags (append cmd opts))
+ (ignore-case (if (or (member "-S" flags) (member "--smart-case"
flags))
+ (let (case-fold-search)
+ ;; Case insensitive if there are no
uppercase letters
+ (not (string-match-p "[[:upper:]]" arg)))
+ (or (member "-i" flags) (member "--ignore-case"
flags)))))
+ (if (or (member "-F" flags) (member "--fixed-strings" flags))
+ `(:command (,@cmd "-e" ,arg ,@opts) :highlight
+ ,(apply-partially #'consult--highlight-regexps
+ (list (regexp-quote arg)) ignore-case))
+ (pcase-let* ((type (consult--ripgrep-regexp-type (car cmd)))
+ (`(,re . ,hl) (funcall consult--regexp-compiler arg type
ignore-case)))
+ (when re
+ `(:command
+ (,@cmd ,@(and (eq type 'pcre) '("-P"))
+ "-e" ,(consult--join-regexps re type)
+ ,@opts)
+ :highlight ,hl))))))
;;;###autoload
(defun consult-ripgrep (&optional dir initial)
