[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master cec8779 075/173: Introduce company-search-regexp-function
From: |
Dmitry Gutov |
Subject: |
[elpa] master cec8779 075/173: Introduce company-search-regexp-function |
Date: |
Thu, 23 Jun 2016 00:28:39 +0000 (UTC) |
branch: master
commit cec87798951154b7ff08f31dee96539b816aeaf3
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>
Introduce company-search-regexp-function
Closes #313, closes #411.
---
NEWS.md | 1 +
company.el | 93 ++++++++++++++++++++++++++++++++++++++++++++++--------------
2 files changed, 72 insertions(+), 22 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index a99d304..30f085e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,7 @@
## Next
+* New user option `company-search-regexp-function`.
* Completion is not started automatically when a keyboard macro is being
recorded ([#374](https://github.com/company-mode/company-mode/issues/374)).
* New command `company-indent-or-complete-common`.
diff --git a/company.el b/company.el
index a90c0c6..2472c29 100644
--- a/company.el
+++ b/company.el
@@ -62,6 +62,7 @@
(require 'cl-lib)
(require 'newcomment)
+(require 'pcase)
;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
@@ -1608,6 +1609,17 @@ from the rest of the backends in the group, if any, will
be left at the end."
;;; search
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defcustom company-search-regexp-function #'regexp-quote
+ "Function to construct the search regexp from input.
+It's called with one argument, the current search input. It must return
+either a regexp without groups, or one where groups don't intersect and
+each one wraps a part of the input string."
+ :type '(choice
+ (const :tag "Exact match" regexp-quote)
+ (const :tag "Words separated with spaces"
company-search-words-regexp)
+ (const :tag "Words separated with spaces, in any order"
+ company-search-words-in-any-order-regexp)))
+
(defvar-local company-search-string "")
(defvar company-search-lighter '(" "
@@ -1623,11 +1635,33 @@ from the rest of the backends in the group, if any,
will be left at the end."
(defvar-local company--search-old-changed nil)
+(defun company-search-words-regexp (input)
+ (mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t) ".*"))
+
+(defun company-search-words-in-any-order-regexp (input)
+ (let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t)))
+ (permutations (company--permutations words)))
+ (mapconcat (lambda (words)
+ (mapconcat #'identity words ".*"))
+ permutations
+ "\\|")))
+
+(defun company--permutations (lst)
+ (if (not lst)
+ '(nil)
+ (cl-mapcan
+ (lambda (e)
+ (mapcar (lambda (perm) (cons e perm))
+ (company--permutations (cl-remove e lst :count 1))))
+ lst)))
+
(defun company--search (text lines)
- (let ((quoted (regexp-quote text))
+ (let ((re (funcall company-search-regexp-function text))
(i 0))
(cl-dolist (line lines)
- (when (string-match quoted line (length company-prefix))
+ (when (string-match-p re line (length company-prefix))
(cl-return i))
(cl-incf i))))
@@ -1645,11 +1679,12 @@ from the rest of the backends in the group, if any,
will be left at the end."
(company--search-update-predicate ss))
(company--search-update-string ss)))
-(defun company--search-update-predicate (&optional ss)
- (let* ((company-candidates-predicate
- (and (not (string= ss ""))
+(defun company--search-update-predicate (ss)
+ (let* ((re (funcall company-search-regexp-function ss))
+ (company-candidates-predicate
+ (and (not (string= re ""))
company-search-filtering
- (lambda (candidate) (string-match ss candidate))))
+ (lambda (candidate) (string-match re candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
@@ -2323,16 +2358,18 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
mouse-face company-tooltip-mouse)
line))
(when selected
- (if (and (not (string= company-search-string ""))
- (string-match (regexp-quote company-search-string) value
- (length company-prefix)))
- (let ((beg (+ margin (match-beginning 0)))
- (end (+ margin (match-end 0)))
- (width (- width (length right))))
- (when (< beg width)
- (add-text-properties beg (min end width)
- '(face company-tooltip-search)
- line)))
+ (if (let ((re (funcall company-search-regexp-function
+ company-search-string)))
+ (and (not (string= re ""))
+ (string-match re value (length company-prefix))))
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (let ((beg (+ margin mbeg))
+ (end (+ margin mend))
+ (width (- width (length right))))
+ (when (< beg width)
+ (add-text-properties beg (min end width)
+ '(face company-tooltip-search)
+ line))))
(add-text-properties 0 width '(face company-tooltip-selection
mouse-face company-tooltip-selection)
line)
@@ -2342,6 +2379,16 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
line)))
line))
+(defun company--search-chunks ()
+ (let ((md (match-data t))
+ res)
+ (if (<= (length md) 2)
+ (push (cons (nth 0 md) (nth 1 md)) res)
+ (while (setq md (nthcdr 2 md))
+ (when (car md)
+ (push (cons (car md) (cadr md)) res))))
+ res))
+
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
@@ -2725,12 +2772,14 @@ Returns a negative number if the tooltip should be
displayed above point."
'(face company-preview-common) completion)
;; Add search string
- (and company-search-string
- (string-match (regexp-quote company-search-string) completion)
- (add-text-properties (match-beginning 0)
- (match-end 0)
- '(face company-preview-search)
- completion))
+ (and (string-match (funcall company-search-regexp-function
+ company-search-string)
+ completion)
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (add-text-properties mbeg
+ mend
+ '(face company-preview-search)
+ completion)))
(setq completion (company-strip-prefix completion))
- [elpa] master 478f124 087/173: company-dabbrev-code-modes: Improve Customize labels, (continued)
- [elpa] master 478f124 087/173: company-dabbrev-code-modes: Improve Customize labels, Dmitry Gutov, 2016/06/22
- [elpa] master 4a6eea9 089/173: Use company-dabbrev-char-regexp more consistently (#433), Dmitry Gutov, 2016/06/22
- [elpa] master a3858be 086/173: Ignore trigger key prefixes that are shorter than symbol-at-point, Dmitry Gutov, 2016/06/22
- [elpa] master 3726fe2 093/173: [ci skip] Use the "generic" language, Dmitry Gutov, 2016/06/22
- [elpa] master 946c798 095/173: Handle empty list of candidates, Dmitry Gutov, 2016/06/22
- [elpa] master c656b25 079/173: Merge pull request #418 from PythonNut/master, Dmitry Gutov, 2016/06/22
- [elpa] master 931e758 101/173: Fix the workaround, Dmitry Gutov, 2016/06/22
- [elpa] master 049b0e6 048/173: company--begin-new: Check the value of c, Dmitry Gutov, 2016/06/22
- [elpa] master 250ca1c 088/173: Add company-etags-everywhere, Dmitry Gutov, 2016/06/22
- [elpa] master 21da29b 082/173: Update copyright, Dmitry Gutov, 2016/06/22
- [elpa] master cec8779 075/173: Introduce company-search-regexp-function,
Dmitry Gutov <=
- [elpa] master 6165cb2 083/173: Don't "adjust key" (#422), Dmitry Gutov, 2016/06/22
- [elpa] master e5177c9 105/173: Add company-tooltip-annotation-selection face, Dmitry Gutov, 2016/06/22
- [elpa] master 75e21f6 045/173: company-css: Support web-mode, Dmitry Gutov, 2016/06/22
- [elpa] master e6ea779 004/173: Add `company-diag', Dmitry Gutov, 2016/06/22
- [elpa] master 0b37d17 044/173: company-mode: Mention the sorting order, Dmitry Gutov, 2016/06/22
- [elpa] master c6af7d2 061/173: Mention the previous change in NEWS [ci skip], Dmitry Gutov, 2016/06/22
- [elpa] master 5d68a50 069/173: [Fix #317] Allow :sorted keyword in grouped backends, Dmitry Gutov, 2016/06/22
- [elpa] master 87351aa 073/173: Double space, Dmitry Gutov, 2016/06/22
- [elpa] master 8952cfe 085/173: Handle key prefix being shorter than prefix (#422), Dmitry Gutov, 2016/06/22
- [elpa] master c2e5981 017/173: Remove company-ropemacs, Dmitry Gutov, 2016/06/22