;;; frontends-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
(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-uses-company-face ()
+(ert-deftest company-fill-propertize-overrides-face-property ()
(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)))
+ (str1 (propertize "str1" 'face 'foo))
+ (str2 (propertize "str2" 'face 'foo)))
+ (should (ert-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 company-tooltip)
+ 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)))
+ ;; Could use `ert-equal-including-properties' as well.
+ (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)
- '(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))))))
+ '(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)