Add support for company-face

[gnu-emacs-elpa] / company.el

diff --git a/company.el b/company.el
index c1af40bc6ca3a4f01f5f47bb58439efa817f916b..18cd2e3e9cd33d3054bcee35d7c95a760106ff94 100644 (file)
--- a/company.el
+++ b/company.el
@@ -830,9 +830,15 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
     (or (match-string-no-properties (or expression 0)) "")))
 
 (defun company-grab-line (regexp &optional expression)
+  "Return a match string for REGEXP if it matches text before point.
+If EXPRESSION is non-nil, return the match string for the respective
+parenthesized expression in REGEXP.
+Matching is limited to the current line."
   (company-grab regexp expression (point-at-bol)))
 
 (defun company-grab-symbol ()
+  "If point is at the end of a symbol, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
   (if (looking-at "\\_>")
       (buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
                                                 (point)))
@@ -840,6 +846,8 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
       "")))
 
 (defun company-grab-word ()
+  "If point is at the end of a word, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
   (if (looking-at "\\>")
       (buffer-substring (point) (save-excursion (skip-syntax-backward "w")
                                                 (point)))
@@ -847,6 +855,9 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
       "")))
 
 (defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
+  "Return a string SYMBOL or a cons (SYMBOL . t).
+SYMBOL is as returned by `company-grab-symbol'.  If the text before poit
+matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
   (let ((symbol (company-grab-symbol)))
     (when symbol
       (save-excursion
@@ -858,6 +869,7 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
           symbol)))))
 
 (defun company-in-string-or-comment ()
+  "Return non-nil if point is within a string or comment."
   (let ((ppss (syntax-ppss)))
     (or (car (setq ppss (nthcdr 3 ppss)))
         (car (setq ppss (cdr ppss)))
@@ -1187,7 +1199,7 @@ can retrieve meta-data for them."
   (unless (company-call-backend 'sorted)
     (setq candidates (sort candidates 'string<)))
   (when (company-call-backend 'duplicates)
-    (company--strip-duplicates candidates))
+    (setq candidates (company--strip-duplicates candidates)))
   candidates)
 
 (defun company--postprocess-candidates (candidates)
@@ -1198,27 +1210,37 @@ can retrieve meta-data for them."
   (company--transform-candidates candidates))
 
 (defun company--strip-duplicates (candidates)
-  (let ((c2 candidates)
-        (annos 'unk))
-    (while c2
-      (setcdr c2
-              (let ((str (pop c2)))
-                (while (let ((str2 (car c2)))
-                         (if (not (equal str str2))
-                             (progn
-                               (setq annos 'unk)
-                               nil)
-                           (when (eq annos 'unk)
-                             (setq annos (list (company-call-backend
-                                                'annotation str))))
-                           (let ((anno2 (company-call-backend
-                                         'annotation str2)))
-                             (if (member anno2 annos)
-                                 t
-                               (push anno2 annos)
-                               nil))))
-                  (pop c2))
-                c2)))))
+  (let* ((annos 'unk)
+         (str (car candidates))
+         (ref (cdr candidates))
+         res str2 anno2)
+    (while ref
+      (setq str2 (pop ref))
+      (if (not (equal str str2))
+          (progn
+            (push str res)
+            (setq str str2)
+            (setq annos 'unk))
+        (setq anno2 (company-call-backend
+                     'annotation str2))
+        (cond
+         ((null anno2))             ; Skip it.
+         ((when (eq annos 'unk)
+            (let ((ann1 (company-call-backend 'annotation str)))
+              (if (null ann1)
+                  ;; No annotation on the earlier element, drop it.
+                  t
+                (setq annos (list ann1))
+                nil)))
+          (setq annos (list anno2))
+          (setq str str2))
+         ((member anno2 annos))     ; Also skip.
+         (t
+          (push anno2 annos)
+          (push str res)            ; Maintain ordering.
+          (setq str str2)))))
+    (when str (push str res))
+    (nreverse res)))
 
 (defun company--transform-candidates (candidates)
   (let ((c candidates))
@@ -2212,6 +2234,9 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
           require-match)))
      callback)))
 
+(declare-function find-library-name "find-func")
+(declare-function lm-version "lisp-mnt")
+
 (defun company-version (&optional show-version)
   "Get the Company version as string.
 
@@ -2380,6 +2405,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
                              '(face company-tooltip-common-selection
                                mouse-face company-tooltip-selection)
                              line)))
+    (company--apply-company-face line)
     line))
 
 (defun company--search-chunks ()
@@ -2392,6 +2418,21 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
           (push (cons (car md) (cadr md)) res))))
     res))
 
+(defun company--apply-company-face (str)
+  (let ((start (if (get-text-property 0 'company-face str)
+                   0
+                 (next-single-property-change 0 'company-face str)))
+        end value)
+    (while start
+      (setq end (or (next-single-property-change start 'company-face str)
+                    (length str)))
+      (setq value (get-text-property start 'company-face str))
+      (font-lock-prepend-text-property start end 'face value str)
+      (font-lock-prepend-text-property start end 'mouse-face value str)
+      (setq start (next-single-property-change end 'company-face str)))
+    (when end
+      (remove-text-properties 0 end '(company-face) str))))
+
 (defun company--clean-string (str)
   (replace-regexp-in-string
    "\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"