]> code.delx.au - gnu-emacs-elpa/commitdiff
Add support for company-face
authorDmitry Gutov <dgutov@yandex.ru>
Sat, 26 Dec 2015 03:10:45 +0000 (05:10 +0200)
committerDmitry Gutov <dgutov@yandex.ru>
Sat, 26 Dec 2015 03:10:45 +0000 (05:10 +0200)
#437.

company.el
test/frontends-tests.el

index 498920afbf414bfc99a94d76251987f6156bfe48..18cd2e3e9cd33d3054bcee35d7c95a760106ff94 100644 (file)
@@ -2405,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 ()
@@ -2417,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:]]"
index 7348cbde967b1f6154bf2092d40b643e43db8151..b35fe76f6017d5755bf7715b9556fcb6861c612f 100644 (file)
              #(" bar "
                0 5 (face company-tooltip mouse-face company-tooltip-mouse))))))
 
+(ert-deftest company-fill-propertize-uses-company-face ()
+  (let ((company-backend #'ignore)
+        (company-prefix "")
+        (str1 "str1")
+        (str2 "str2"))
+    (put-text-property 0 3 'company-face 'boo str1)
+    (put-text-property 1 4 'company-face 'boo str2)
+    (let ((res (company-fill-propertize str1 nil 10 nil nil nil)))
+      ;; `equal-including-properties' uses `eq' for properties.
+      (equal-including-properties
+       (substring res 3 10)
+       #("      " 0 6 (face company-tooltip mouse-face company-tooltip-mouse)))
+      (should (equal (get-text-property 0 'face res)
+                     '(boo company-tooltip)))
+      (should (equal (get-text-property 2 'mouse-face res)
+                     '(boo company-tooltip-mouse))))
+    (let ((res (company-fill-propertize str2 nil 4 nil nil nil)))
+      (equal-including-properties
+       (substring res 0 1)
+       #("s" 0 1 (face company-tooltip mouse-face company-tooltip-mouse)))
+      (should (equal (get-text-property 1 'face res)
+                     '(boo company-tooltip)))
+      (should (equal (get-text-property 3 'mouse-face res)
+                     '(boo company-tooltip-mouse))))))
+
 (ert-deftest company-column-with-composition ()
   :tags '(interactive)
   (with-temp-buffer