Add support for deprecated property

NEWS.md

@@ -2,6 +2,8 @@
 
 ## Next
 
+* New back-end command, `deprecated`. It returns whether the completion item is
+  deprecated or not.
 * `company-tooltip-common` highlightings with non-prefix and prefix matching
   backends are more compatible: if the non-prefix matching backend's completions
   all have a common part, and so the current prefix can be expanded with
@@ -134,7 +136,7 @@
 * `company-idle-delay` now accepts a function which generates the idle time or
   nil indicating no idle completion.
 * Add custom variable `company-show-numbers-function` to make numbers of
-  candidates customizable. 
+  candidates customizable.
 * When a symbol is already typed in full, calling `M-x company-complete` will
   now run its post-completion action (e.g. inserting method parameters
   template). Calling `M-x company-manual-begin` or invoking a backend command

company-capf.el

@@ -153,6 +153,10 @@ so we can't just use the preceding variable instead.")
      (let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
                          :company-kind)))
        (when f (funcall f arg))))
+    (`deprecated
+     (let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
+                         :company-deprecated)))
+       (when f (funcall f arg))))
     (`require-match
      (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
     (`init nil)      ;Don't bother: plenty of other ways to initialize the code.

company.el

@@ -92,6 +92,10 @@
     (t (:background "green")))
   "Face used for the selection in the tooltip.")
 
+(defface company-tooltip-deprecated
+  '((t (:inherit default :strike-through t)))
+  "Face used for the deprecated items.")
+
 (defface company-tooltip-search
   '((default :inherit highlight))
   "Face used for the search string in the tooltip.")
@@ -333,7 +337,7 @@ This doesn't include the margins and the scroll bar."
                               company-clang
                               company-files
                               (company-dabbrev-code company-gtags company-etags
-                               company-keywords)
+                                                    company-keywords)
                               company-oddmuse company-dabbrev)
   "The list of active backends (completion engines).
 
@@ -403,6 +407,9 @@ be kept if they have different annotations.  For that to work properly,
 backends should store the related information on candidates using text
 properties.
 
+`deprecated': The second argument is a completion candidate.  Return
+non-nil if the completion candidate is deprecated.
+
 `match': The second argument is a completion candidate.  Return a positive
 integer, the index after the end of text matching `prefix' within the
 candidate string.  Alternatively, return a list of (CHUNK-START
@@ -2987,7 +2994,7 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
         (and company-common `((0 . ,(length company-common))))
         nil)))
 
-(defun company-fill-propertize (value annotation width selected left right)
+(defun company-fill-propertize (value annotation width selected left right deprecated)
   (let* ((margin (length left))
          (company-common (and company-common (company--clean-string company-common)))
          (common (company--common-or-matches value))
@@ -3054,6 +3061,10 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
                                     nil line)))))
     (when selected
       (add-face-text-property 0 width 'company-tooltip-selection t line))
+
+    (when deprecated
+      (add-face-text-property 0 width 'company-tooltip-deprecated t line))
+
     (add-face-text-property 0 width 'company-tooltip t line)
     line))
 
@@ -3290,6 +3301,7 @@ but adjust the expected values appropriately."
     (dotimes (_ len)
       (let* ((value (pop lines-copy))
              (annotation (company-call-backend 'annotation value))
+             (deprecated (company-call-backend 'deprecated value))
              (left (or (pop left-margins)
                        (company-space-string left-margin-size))))
         (setq value (company--clean-string value))
@@ -3298,7 +3310,7 @@ but adjust the expected values appropriately."
           (when company-tooltip-align-annotations
             ;; `lisp-completion-at-point' adds a space.
             (setq annotation (string-trim-left annotation))))
-        (push (list value annotation left) items)
+        (push (list value annotation left deprecated) items)
         (setq width (max (+ (length value)
                             (if (and annotation company-tooltip-align-annotations)
                                 (1+ (length annotation))
@@ -3327,6 +3339,7 @@ but adjust the expected values appropriately."
                (str (car item))
                (annotation (cadr item))
                (left (nth 2 item))
+               (deprecated (nth 3 item))
                (right (company-space-string company-tooltip-margin))
                (width width)
                (selected (equal selection i)))
@@ -3343,7 +3356,8 @@ but adjust the expected values appropriately."
                  (company-fill-propertize str annotation
                                           width selected
                                           left
-                                          right)
+                                          right
+                                          deprecated)
                  (when scrollbar-bounds
                    (company--scrollbar i scrollbar-bounds)))
                 new)))

test/capf-tests.el

@@ -79,7 +79,7 @@
     (let* ((cand (car (member "with-current-buffer" company-candidates)))
            (render
             (and cand
-                 (company-fill-propertize cand nil (length cand) nil nil nil))))
+                 (company-fill-propertize cand nil (length cand) nil nil nil nil))))
       ;; remove text properties that aren't relevant to our test
       (company--remove-but-these-properties render '(face))
       (should
@@ -109,7 +109,7 @@
     (let* ((cand (car (member "with-current-buffer" company-candidates)))
            (render
             (and cand
-                 (company-fill-propertize cand nil (length cand) nil nil nil))))
+                 (company-fill-propertize cand nil (length cand) nil nil nil nil))))
       ;; remove text properties that aren't relevant to our test
       (company--remove-but-these-properties render '(face))
       (should
@@ -133,7 +133,7 @@
     (let* ((cand (car (member "with-current-buffer" company-candidates)))
            (render
             (and cand
-                 (company-fill-propertize cand nil (length cand) nil nil nil))))
+                 (company-fill-propertize cand nil (length cand) nil nil nil nil))))
       ;; remove text properties that aren't relevant to our test
       (company--remove-but-these-properties render '(face))
       (should

test/frontends-tests.el

@@ -308,28 +308,34 @@
         (company-backend #'ignore)
         (company-prefix ""))
     (should (ert-equal-including-properties
-             (company-fill-propertize "barfoo" nil 6 t nil nil)
+             (company-fill-propertize "barfoo" nil 6 t nil nil nil)
              #("barfoo"
                0 3 (face (company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse))
                3 6 (face (company-tooltip-search-selection company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse)))))
     (should (ert-equal-including-properties
-             (company-fill-propertize "barfoo" nil 5 t "" " ")
+             (company-fill-propertize "barfoo" nil 5 t "" " " nil)
              #("barfo "
                0 3 (face (company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse))
                3 5 (face (company-tooltip-search-selection company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse))
                5 6 (face (company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse)))))
     (should (ert-equal-including-properties
-             (company-fill-propertize "barfoo" nil 3 t " " " ")
+             (company-fill-propertize "barfoo" nil 3 t " " " " nil)
              #(" bar "
-               0 5 (face (company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse)))))))
+               0 5 (face (company-tooltip-selection company-tooltip) mouse-face (company-tooltip-mouse)))))
+    (should (ert-equal-including-properties
+             (company-fill-propertize "barfoo" nil 5 t "" " " t)
+             #("barfo "
+               0 3 (face (company-tooltip-selection company-tooltip-deprecated company-tooltip) mouse-face (company-tooltip-mouse))
+               3 5 (face (company-tooltip-search-selection company-tooltip-selection company-tooltip-deprecated company-tooltip) mouse-face (company-tooltip-mouse))
+               5 6 (face (company-tooltip-selection company-tooltip-deprecated 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)))
     (should (ert-equal-including-properties
-             (company-fill-propertize str1 str2 8 nil nil nil)
+             (company-fill-propertize str1 str2 8 nil nil nil nil)
              #("str1str2"
                0 4 (face company-tooltip mouse-face (company-tooltip-mouse))
                4 8 (face (company-tooltip-annotation company-tooltip)
@@ -347,7 +353,7 @@
         (company-prefix "")
         (str1 (propertize "str1" 'foo 'bar))
         (str2 (propertize "str2" 'foo 'bar)))
-    (let ((res (company-fill-propertize str1 str2 8 nil nil nil)))
+    (let ((res (company-fill-propertize str1 str2 8 nil 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))