"Face used for the tooltip.")
(defface company-tooltip-selection
- '((default :inherit company-tooltip)
- (((class color) (min-colors 88) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "light blue"))
(((class color) (min-colors 88) (background dark))
(:background "orange1"))
"Face used for the tooltip item under the mouse.")
(defface company-tooltip-common
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "darkred")
(((background dark))
:foreground "red"))
"Face used for the common completion in the tooltip.")
(defface company-tooltip-common-selection
- '((default :inherit company-tooltip-selection)
- (((background light))
- :foreground "darkred")
- (((background dark))
- :foreground "red"))
+ '((default :inherit company-tooltip-common))
"Face used for the selected common completion in the tooltip.")
(defface company-tooltip-annotation
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "firebrick4")
(((background dark))
:foreground "red4"))
"Face used for the tooltip scrollbar thumb.")
(defface company-scrollbar-bg
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:background "wheat")
(((background dark))
:background "gold"))
(defface company-preview
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit (company-tooltip-selection company-tooltip))
(((background dark))
:background "blue4"
:foreground "wheat"))
(defface company-preview-common
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit company-tooltip-common-selection)
(((background dark))
:inherit company-preview
:foreground "red"))
(if company-common
(string-width company-common)
0)))
+ (_ (setq value (company--pre-render value)
+ annotation (and annotation (company--pre-render annotation t))))
(ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width
(+ (length value) (length annotation)
(setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
- (add-text-properties 0 width '(face company-tooltip
- mouse-face company-tooltip-mouse)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common
- mouse-face company-tooltip-mouse)
- line)
+ (font-lock-append-text-property 0 width 'mouse-face
+ 'company-tooltip-mouse
+ line)
(when (< ann-start ann-end)
- (add-text-properties ann-start ann-end
- '(face company-tooltip-annotation
- mouse-face company-tooltip-mouse)
- line))
+ (font-lock-append-text-property ann-start ann-end 'face
+ 'company-tooltip-annotation
+ line))
+ (font-lock-prepend-text-property margin common 'face
+ (if selected
+ 'company-tooltip-common-selection
+ 'company-tooltip-common)
+ line)
(when selected
(if (let ((re (funcall company-search-regexp-function
company-search-string)))
(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)
- (add-text-properties margin common
- '(face company-tooltip-common-selection
- mouse-face company-tooltip-selection)
- line)))
+ (font-lock-prepend-text-property beg (min end width)
+ 'face 'company-tooltip-search
+ line))))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip-selection
+ line)))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip
+ line)
line))
(defun company--search-chunks ()
(push (cons (car md) (cadr md)) res))))
res))
+(defun company--pre-render (str &optional annotation-p)
+ (or (company-call-backend 'pre-render str annotation-p)
+ (progn
+ (when (or (text-property-not-all 0 (length str) 'face nil str)
+ (text-property-not-all 0 (length str) 'mouse-face nil str))
+ (setq str (copy-sequence str))
+ (remove-text-properties 0 (length str)
+ '(face nil font-lock-face nil mouse-face nil)
+ str))
+ str)))
+
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
(company-preview-hide)
(let ((completion (nth company-selection company-candidates)))
- (setq completion (propertize completion 'face 'company-preview))
- (add-text-properties 0 (length company-common)
- '(face company-preview-common) completion)
+ (setq completion (copy-sequence (company--pre-render completion)))
+ (font-lock-append-text-property 0 (length completion)
+ 'face 'company-preview
+ completion)
+ (font-lock-prepend-text-property 0 (length company-common)
+ 'face 'company-preview-common
+ completion)
;; Add search string
(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)))
+ (font-lock-prepend-text-property mbeg mend
+ 'face 'company-preview-search
+ completion)))
(setq completion (company-strip-prefix completion))
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
- (list (lambda (c &optional _)
+ (list (lambda (c &rest _)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(set-window-buffer nil (current-buffer))
(save-excursion (insert "\n"))
(let ((company-candidates-length 1)
- (company-candidates '("123")))
+ (company-candidates '("123"))
+ (company-backend #'ignore))
(company-preview-show-at-point (point))
(let* ((ov company-preview-overlay)
(str (overlay-get ov 'after-string)))
(company-candidates (mapcar #'car data))
(company-candidates-length 4)
(company-tooltip-margin 1)
- (company-backend (lambda (cmd &optional arg)
+ (company-backend (lambda (cmd &optional arg &rest _)
(when (eq cmd 'annotation)
(cdr (assoc arg data)))))
company-tooltip-align-annotations)
(should (equal (list (format " %s " (make-string (- ww 2) ?1))
(format " %s " (make-string (- ww 2) ?1)))
res))
- (should (eq 'company-tooltip-common-selection
- (get-text-property (- ww 2) 'face
- (car res))))
- (should (eq 'company-tooltip-selection
- (get-text-property (1- ww) 'face
- (car res))))
+ (should (equal '(company-tooltip-common-selection
+ company-tooltip-selection
+ company-tooltip)
+ (get-text-property (- ww 2) 'face
+ (car res))))
+ (should (equal '(company-tooltip-selection
+ company-tooltip)
+ (get-text-property (1- ww) 'face
+ (car res))))
)))
(ert-deftest company-create-lines-clears-out-non-printables ()
(alist '(("a" . " ︸") ("b" . " ︸︸")))
(company-candidates (mapcar #'car alist))
(company-candidates-length 2)
- (company-backend (lambda (c &optional a)
+ (company-backend (lambda (c &optional a &rest _)
(when (eq c 'annotation)
(assoc-default a alist)))))
(should (equal '(" a ︸ "
"MIRAI発売2カ月"))
(company-candidates-length 2)
(company-prefix "MIRAI発")
- (company-backend (lambda (c &optional _arg)
+ (company-backend (lambda (c &rest _)
(pcase c
(`ignore-case 'keep-prefix)))))
(should (equal '(" MIRAI発売1カ月 "
(let ((company-search-string "foo")
(company-backend #'ignore)
(company-prefix ""))
- (should (equal-including-properties
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 6 t nil nil)
#("barfoo"
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 6 (face company-tooltip-search mouse-face company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 6 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 5 t "" " ")
#("barfo "
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 5 (face company-tooltip-search mouse-face company-tooltip-mouse)
- 5 6 (face company-tooltip mouse-face company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 5 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse))
+ 5 6 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 3 t " " " ")
#(" bar "
- 0 5 (face company-tooltip mouse-face company-tooltip-mouse))))))
+ 0 5 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))))
+
+(ert-deftest company-fill-propertize-overrides-face-property ()
+ (let ((company-backend #'ignore)
+ (company-prefix "")
+ (str1 (propertize "str1" 'face 'foo))
+ (str2 (propertize "str2" 'face 'foo)))
+ (equal-including-properties
+ (company-fill-propertize str1 str2 8 nil nil nil)
+ #("str1str2"
+ 0 4 (face company-tooltip mouse-face company-tooltip-mouse)
+ 4 8 (face company-tooltip-annotation mouse-face company-tooltip-mouse)))))
+
+(ert-deftest company-fill-propertize-delegates-to-pre-render ()
+ (let ((company-backend
+ (lambda (command &rest args)
+ (pcase command
+ (`pre-render
+ (propertize (car args)
+ 'face (if (cadr args)
+ 'annotation
+ 'value))))))
+ (company-prefix "")
+ (str1 (propertize "str1" 'foo 'bar))
+ (str2 (propertize "str2" 'foo 'bar)))
+ (let ((res (company-fill-propertize str1 str2 8 nil nil nil)))
+ (should (eq (get-text-property 0 'foo res) 'bar))
+ (should (eq (get-text-property 4 'foo res) 'bar))
+ (should (equal (get-text-property 0 'face res)
+ '(value company-tooltip)))
+ (should (equal (get-text-property 4 'face res)
+ '(annotation company-tooltip-annotation company-tooltip))))))
(ert-deftest company-column-with-composition ()
:tags '(interactive)