branch: master
commit 392dadddb8f97062a2a390cba45d4c55867c2248
Author: João Távora <[email protected]>
Commit: João Távora <[email protected]>
Per #798, #762: Fix company-capf's highlighting of non-prefix matches
In the process, allow a list of regions as a response to a `match' request.
* company-capf.el (company-capf): In match, sniff for face changes in
completion candidate.
* company.el (company-fill-propertize): Accept a list of regions to
highlight as a response to a match request.
(company-backends): Describe new `match' behaviour in docstring.
---
company-capf.el | 29 +++++++++++++++++------------
company.el | 28 ++++++++++++++++++----------
2 files changed, 35 insertions(+), 22 deletions(-)
diff --git a/company-capf.el b/company-capf.el
index 5d174a3..5613333 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -112,18 +112,23 @@
(nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
(cdr (assq 'display-sort-function meta))))))
(`match
- ;; Can't just use 0 when base-size (see above) is non-zero.
- (let ((start (if (get-text-property 0 'face arg)
- 0
- (next-single-property-change 0 'face arg))))
- (when start
- ;; completions-common-part comes first, but we can't just look for
this
- ;; value because it can be in a list.
- (or
- (let ((value (get-text-property start 'face arg)))
- (text-property-not-all start (length arg)
- 'face value arg))
- (length arg)))))
+ (let* ((match-start nil) (pos -1)
+ (prop-value nil) (faces nil)
+ (has-face-p nil) chunks
+ (limit (length arg)))
+ (while (< pos limit)
+ (setq pos
+ (if (< pos 0) 0 (next-property-change pos arg limit)))
+ (setq prop-value (or (get-text-property pos 'face arg)
+ (get-text-property pos 'font-lock-face arg))
+ faces (if (listp prop-value) prop-value (list prop-value))
+ has-face-p (memq 'completions-common-part faces))
+ (cond ((and (not match-start) has-face-p)
+ (setq match-start pos))
+ ((and match-start (not has-face-p))
+ (push (cons match-start pos) chunks)
+ (setq match-start nil))))
+ (if chunks (nreverse chunks) (cons 0 (length arg)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
;non-prefix matches.
diff --git a/company.el b/company.el
index e465495..1259b6c 100644
--- a/company.el
+++ b/company.el
@@ -403,10 +403,13 @@ be kept if they have different annotations. For that to
work properly,
backends should store the related information on candidates using text
properties.
-`match': The second argument is a completion candidate. Return the index
-after the end of text matching `prefix' within the candidate string. It
-will be used when rendering the popup. This command only makes sense for
-backends that provide non-prefix completion.
+`match': The second argument is a completion candidate. Return a positive
+integer, the index after the end of text matching `prefix' within the
+candidate string. Alternatively, return a list of (CHUNK-START
+. CHUNK-END) elements, where CHUNK-START and CHUNK-END are indexes within
+the candidate string. The corresponding regions are be used when rendering
+the popup. This command only makes sense for backends that provide
+non-prefix completion.
`require-match': If this returns t, the user is not allowed to enter
anything not offered as a candidate. Please don't use that value in normal
@@ -2507,7 +2510,6 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(- width (length
annotation)))
annotation))
right)))
- (setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
(font-lock-append-text-property 0 width 'mouse-face
@@ -2519,11 +2521,17 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
'company-tooltip-annotation-selection
'company-tooltip-annotation)
line))
- (font-lock-prepend-text-property margin common 'face
- (if selected
- 'company-tooltip-common-selection
- 'company-tooltip-common)
- line)
+ (cl-loop
+ with width = (- width (length right))
+ for (comp-beg . comp-end) in (if (integerp common) `((0 . ,common))
common)
+ for inline-beg = (+ margin comp-beg)
+ for inline-end = (min (+ margin comp-end) width)
+ when (< inline-beg width)
+ do (font-lock-prepend-text-property inline-beg inline-end 'face
+ (if selected
+ 'company-tooltip-common-selection
+ 'company-tooltip-common)
+ line))
(when (let ((re (funcall company-search-regexp-function
company-search-string)))
(and (not (string= re ""))
