[ELPA-diffs] [elpa] 02/05: company-capf: Highlight the "common" part

[Dmitry Gutov]

This is an automated email from the git hooks/post-receive script.

dgutov pushed a commit to branch master
in repository elpa.

commit 4b18b9a65008f74cb53fed88a1e337fecaa3317a
Author: Dmitry Gutov <address@hidden>
Date:   Wed Jan 15 04:55:50 2014 +0200

    company-capf: Highlight the "common" part
    
    As in "the part of the candidate up to the last matched character".
    Now for partial completion, too.
---
 company-capf.el |   13 +++++++++++
 company.el      |   60 ++++++++++++++++++++++++++++++------------------------
 2 files changed, 46 insertions(+), 27 deletions(-)

diff --git a/company-capf.el b/company-capf.el
index 2fcfbfb..8575cd1 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -77,6 +77,19 @@ Requires Emacs 24.1 or newer."
                       (buffer-substring (nth 1 res) (nth 2 res))
                       (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
            (cdr (assq 'display-sort-function meta))))))
+    (`common-part
+     ;; 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)))))
     (`duplicates nil) ;Don't bother.
     (`no-cache t)     ;FIXME: Improve!
     (`meta
diff --git a/company.el b/company.el
index 1a324c7..5d1355e 100644
--- a/company.el
+++ b/company.el
@@ -1677,34 +1677,40 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
       (pop copy))
     (apply 'concat pieces)))
 
+(defun company--highlight-common (line properties)
+  ;; XXX: Subject to change.
+  (let ((common (or (company-call-backend 'common-part line)
+                    (length company-common))))
+    (add-text-properties 0 common properties line)))
+
 (defun company-fill-propertize (line width selected)
-  (setq line (company-safe-substring line 0 width))
-  (add-text-properties 0 width '(face company-tooltip
-                                 mouse-face company-tooltip-mouse)
-                       line)
-  (add-text-properties 0 (length company-common)
-                       '(face company-tooltip-common
-                         mouse-face company-tooltip-mouse)
-                       line)
-  (when selected
-    (if (and company-search-string
-             (string-match (regexp-quote company-search-string) line
-                           (length company-prefix)))
-        (progn
-          (add-text-properties (match-beginning 0) (match-end 0)
-                               '(face company-tooltip-selection)
-                               line)
-          (when (< (match-beginning 0) (length company-common))
-            (add-text-properties (match-beginning 0) (length company-common)
-                                 '(face company-tooltip-common-selection)
-                                 line)))
-      (add-text-properties 0 width '(face company-tooltip-selection
-                                          mouse-face company-tooltip-selection)
-                           line)
-      (add-text-properties 0 (length company-common)
-                           '(face company-tooltip-common-selection
-                             mouse-face company-tooltip-selection)
-                           line)))
+  (let ((common (or (company-call-backend 'common-part line)
+                    (length company-common))))
+    (setq line (company-safe-substring line 0 width))
+    (add-text-properties 0 width '(face company-tooltip
+                                   mouse-face company-tooltip-mouse)
+                         line)
+    (add-text-properties 0 common '(face company-tooltip-common
+                                    mouse-face company-tooltip-mouse)
+                         line)
+    (when selected
+      (if (and company-search-string
+               (string-match (regexp-quote company-search-string) line
+                             (length company-prefix)))
+          (progn
+            (add-text-properties (match-beginning 0) (match-end 0)
+                                 '(face company-tooltip-selection)
+                                 line)
+            (when (< (match-beginning 0) common)
+              (add-text-properties (match-beginning 0) common
+                                   '(face company-tooltip-common-selection)
+                                   line)))
+        (add-text-properties 0 width '(face company-tooltip-selection
+                                       mouse-face company-tooltip-selection)
+                             line)
+        (add-text-properties 0 common '(face company-tooltip-common-selection
+                                        mouse-face company-tooltip-selection)
+                             line))))
   line)
 
 ;;; replace

-- 
To stop receiving notification emails like this one, please contact
the administrator of this repository.