emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 18/21: Display annotations


From: Dmitry Gutov
Subject: [elpa] 18/21: Display annotations
Date: Mon, 03 Feb 2014 17:36:19 +0000

dgutov pushed a commit to branch master
in repository elpa.

commit 4fe2993438f1b8e967102d8546925d8a9544146b
Author: Dmitry Gutov <address@hidden>
Date:   Mon Feb 3 17:16:47 2014 +0200

    Display annotations
    
    To be used instead of the undocumented and now deprecated command `crop'.
    
    http://debbugs.gnu.org/16555
    #31
---
 NEWS.md          |    3 +
 company-capf.el  |    5 ++
 company-clang.el |   45 +++++++++-----
 company-eclim.el |   33 ++++++-----
 company-tests.el |   33 ++++++++++-
 company.el       |  169 ++++++++++++++++++++++++++++++++++--------------------
 6 files changed, 193 insertions(+), 95 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 46799bc..1382b6e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,9 @@
 
 ## Next
 
+* New back-end command, `annotation`, for text displayed inline in the popup
+  that's not a part of completion candidate.
+* `company-capf`, `company-clang` and `company-eclim` use `annotation`.
 * `company-preview*` faces inherit from `company-tooltip-selection` and
   `company-tooltip-common-selection` on light themes.
 * New user option `company-transformers`.
diff --git a/company-capf.el b/company-capf.el
index 17ebf7c..574a70d 100644
--- a/company-capf.el
+++ b/company-capf.el
@@ -102,6 +102,11 @@ Requires Emacs 24.1 or newer."
     (`location
      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
        (when f (funcall f arg))))
+    (`annotation
+     (save-excursion
+       (goto-char company-point)
+       (let ((f (plist-get (nthcdr 4 (company--capf-data)) 
:annotation-function)))
+         (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.
diff --git a/company-clang.el b/company-clang.el
index 6d1737a..9427450 100644
--- a/company-clang.el
+++ b/company-clang.el
@@ -109,8 +109,6 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
 
 (defconst company-clang--error-buffer-name "*clang error*")
 
-(defvar company-clang--meta-cache nil)
-
 (defun company-clang--lang-option ()
      (if (eq major-mode 'objc-mode)
          (if (string= "m" (file-name-extension buffer-file-name))
@@ -123,19 +121,32 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
                          (regexp-quote prefix)))
         (case-fold-search nil)
         lines match)
-    (setq company-clang--meta-cache (make-hash-table :test 'equal))
     (while (re-search-forward pattern nil t)
       (setq match (match-string-no-properties 1))
       (unless (equal match "Pattern")
+        (save-match-data
+          (when (string-match ":" match)
+            (setq match (substring match 0 (match-beginning 0)))))
         (let ((meta (match-string-no-properties 2)))
           (when (and meta (not (string= match meta)))
-            (setq meta (company-clang--strip-formatting meta))
-            (when (and (not objc) (string-match "\\((.*)\\)" meta))
-              (setq match (concat match (match-string 1 meta))))
-            (puthash match meta company-clang--meta-cache)))
+            (put-text-property 0 1 'meta
+                               (company-clang--strip-formatting meta)
+                               match)))
         (push match lines)))
     lines))
 
+(defun company-clang--meta (candidate)
+  (get-text-property 0 'meta candidate))
+
+(defun company-clang--annotation (candidate)
+  (let ((meta (company-clang--meta candidate)))
+    (cond
+     ((null meta) nil)
+     ((string-match ":" meta)
+      (substring meta (match-beginning 0)))
+     ((string-match "\\((.*)\\'\\)" meta)
+      (match-string 1 meta)))))
+
 (defun company-clang--strip-formatting (text)
   (replace-regexp-in-string
    "#]" " "
@@ -243,13 +254,15 @@ or automatically through a custom 
`company-clang-prefix-guesser'."
 
 (defun company-clang-objc-templatify (selector)
   (let* ((end (point-marker))
-         (beg (- (point) (length selector)))
+         (beg (- (point) (length selector) 1))
          (templ (company-template-declare-template beg end))
          (cnt 0))
     (save-excursion
       (goto-char beg)
       (catch 'stop
         (while (search-forward ":" end t)
+          (when (looking-at "([^)]*) ?")
+            (delete-region (match-beginning 0) (match-end 0)))
           (company-template-add-field templ (point) (format "arg%d" cnt))
           (if (< (point) end)
               (insert " ")
@@ -284,14 +297,14 @@ passed via standard input."
                  (not (company-in-string-or-comment))
                  (company-clang--prefix)))
     (candidates (company-clang--candidates arg))
-    (meta (gethash arg company-clang--meta-cache))
-    (crop (and (string-match ":\\|(" arg)
-               (substring arg 0 (match-beginning 0))))
-    (post-completion (cond
-                      ((not (derived-mode-p 'objc-mode))
-                       (company-template-c-like-templatify arg))
-                      ((string-match ":" arg)
-                       (company-clang-objc-templatify arg))))))
+    (meta       (company-clang--meta arg))
+    (annotation (company-clang--annotation arg))
+    (post-completion (let ((anno (company-clang--annotation arg)))
+                       (when anno
+                         (insert anno)
+                         (if (string-match ":" anno)
+                             (company-clang-objc-templatify anno)
+                          (company-template-c-like-templatify anno)))))))
 
 (provide 'company-clang)
 ;;; company-clang.el ends here
diff --git a/company-eclim.el b/company-eclim.el
index 70db7c3..d6f699a 100644
--- a/company-eclim.el
+++ b/company-eclim.el
@@ -66,9 +66,6 @@ eclim can only complete correctly when the buffer has been 
saved."
 (defvar company-eclim--project-name nil)
 (make-variable-buffer-local 'company-eclim--project-name)
 
-(defvar company-eclim--doc nil)
-(make-variable-buffer-local 'company-eclim--doc)
-
 (declare-function json-read "json")
 (defvar json-array-type)
 
@@ -110,7 +107,8 @@ eclim can only complete correctly when the buffer has been 
saved."
 (defun company-eclim--candidates (prefix)
   (interactive "d")
   (let ((project-file (file-relative-name buffer-file-name
-                                          (company-eclim--project-dir))))
+                                          (company-eclim--project-dir)))
+        completions)
     (when company-eclim-auto-save
       (when (buffer-modified-p)
         (basic-save-buffer))
@@ -118,8 +116,6 @@ eclim can only complete correctly when the buffer has been 
saved."
       (company-eclim--call-process "java_src_update"
                                    "-p" (company-eclim--project-name)
                                    "-f" project-file))
-    (setq company-eclim--doc
-          (make-hash-table :test 'equal))
     (dolist (item (cdr (assoc 'completions
                               (company-eclim--call-process
                                "java_complete" "-p" 
(company-eclim--project-name)
@@ -130,11 +126,12 @@ eclim can only complete correctly when the buffer has 
been saved."
                                "-l" "standard"))))
       (let* ((meta (cdr (assoc 'info item)))
              (completion meta))
-        (when (string-match " [:-]" completion)
+        (when (string-match " ?[(:-]" completion)
           (setq completion (substring completion 0 (match-beginning 0))))
-        (puthash completion meta company-eclim--doc))))
-  (let ((completion-ignore-case nil))
-    (all-completions prefix company-eclim--doc)))
+        (put-text-property 0 1 'meta meta completion)
+        (push completion completions)))
+    (let ((completion-ignore-case nil))
+      (all-completions prefix completions))))
 
 (defun company-eclim--search-point (prefix)
   (if (or (plusp (length prefix)) (eq (char-before) ?.))
@@ -142,7 +139,12 @@ eclim can only complete correctly when the buffer has been 
saved."
     (point)))
 
 (defun company-eclim--meta (candidate)
-  (gethash candidate company-eclim--doc))
+  (get-text-property 0 'meta candidate))
+
+(defun company-eclim--annotation (candidate)
+  (let ((meta (company-eclim--meta candidate)))
+    (when (string-match "\\(([^-]*\\) -" meta)
+      (substring meta (match-beginning 1) (match-end 1)))))
 
 (defun company-eclim--prefix ()
   (let ((prefix (company-grab-symbol)))
@@ -173,10 +175,11 @@ Completions only work correctly when the buffer has been 
saved.
     (meta (company-eclim--meta arg))
     ;; because "" doesn't return everything
     (no-cache (equal arg ""))
-    (crop (when (string-match "(" arg)
-            (substring arg 0 (match-beginning 0))))
-    (post-completion (when (string-match "([^)]" arg)
-                       (company-template-c-like-templatify arg)))))
+    (annotation (company-eclim--annotation arg))
+    (post-completion (let ((anno (company-eclim--annotation arg)))
+                       (when anno
+                         (insert anno)
+                         (company-template-c-like-templatify anno))))))
 
 (provide 'company-eclim)
 ;;; company-eclim.el ends here
diff --git a/company-tests.el b/company-tests.el
index b986e9b..8d31ab2 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -232,7 +232,7 @@
         (company-call 'open-line 1)
         (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
 
-(ert-deftest company-pseudo-tooltip-overlay-show ()
+(ert-deftest company-pseudo-tooltip-show ()
   :tags '(interactive)
   (with-temp-buffer
     (save-window-excursion
@@ -252,6 +252,37 @@
         (should (string= (overlay-get ov 'company-after)
                          "  123 \nc 45  c\nddd\n")))))))
 
+(ert-deftest company-preview-show-with-annotations ()
+  :tags '(interactive)
+  (with-temp-buffer
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (save-excursion (insert "\n"))
+      (let ((company-candidates-length 1)
+            (company-candidates '("123")))
+        (company-preview-show-at-point (point))
+        (let ((ov company-preview-overlay))
+          (should (string= (overlay-get ov 'display) "123\n")))))))
+
+(ert-deftest company-pseudo-tooltip-show-with-annotations ()
+  :tags '(interactive)
+  (with-temp-buffer
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (insert " ")
+      (save-excursion (insert "\n"))
+      (let ((company-candidates-length 2)
+            (company-backend (lambda (action &optional arg &rest _ignore)
+                               (when (eq action 'annotation)
+                                 (cdr (assoc arg '(("123" . "(4)")))))))
+            (company-candidates '("123" "45")))
+        (company-pseudo-tooltip-show-at-point (point))
+        (let ((ov company-pseudo-tooltip-overlay))
+          ;; With margins.
+          (should (eq (overlay-get ov 'company-width) 8))
+          (should (string= (overlay-get ov 'company-after)
+                           " 123(4) \n 45     \n")))))))
+
 (ert-deftest company-create-lines-shows-numbers ()
   (let ((company-show-numbers t)
         (company-candidates '("x" "y" "z"))
diff --git a/company.el b/company.el
index d2136b5..c2df4cf 100644
--- a/company.el
+++ b/company.el
@@ -123,6 +123,14 @@
      :foreground "red"))
   "Face used for the selected common completion in the tooltip.")
 
+(defface company-tooltip-annotation
+  '((default :inherit company-tooltip)
+    (((background light))
+     :foreground "firebrick4")
+    (((background dark))
+     :foreground "red4"))
+  "Face used for the annotation in the tooltip.")
+
 (defface company-scrollbar-fg
   '((((background light))
      :background "darkred")
@@ -335,6 +343,13 @@ buffer with documentation for it.  Preferably use 
`company-doc-buffer',
 of buffer and buffer location, or of file and line number where the
 completion candidate was defined.
 
+`annotation': The second argument is a completion candidate.  Returns a
+string to be displayed inline with the candidate in the popup.  If
+duplicates are removed by company, candidates with equal string values will
+be kept if they have different annotations.  For that to work properly,
+backends should store the related information with candidates using text
+properties.
+
 `require-match': If this returns t, the user is not allowed to enter
 anything not offered as a candidate.  Use with care!  The default value nil
 gives the user that choice with `company-require-match'.  Return value
@@ -787,8 +802,8 @@ Controlled by `company-auto-complete'.")
   (substring str (length company-prefix)))
 
 (defun company--insert-candidate (candidate)
+  (setq candidate (substring-no-properties candidate))
   ;; XXX: Return value we check here is subject to change.
-  (set-text-properties 0 (length candidate) nil candidate)
   (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
       (insert (company-strip-prefix candidate))
     (delete-region (- (point) (length company-prefix)) (point))
@@ -883,10 +898,16 @@ can retrieve meta-data for them."
     (setq company-common
           (if (cdr company-candidates)
               (company--safe-candidate
-               (try-completion company-prefix company-candidates))
+               (let ((common (try-completion company-prefix 
company-candidates)))
+                 (if (eq common t)
+                     ;; Mulple equal strings, probably with different
+                     ;; annotations.
+                     company-prefix
+                   common)))
             (car company-candidates)))))
 
 (defun company--safe-candidate (str)
+  ;; XXX: This feature is deprecated.
   (or (company-call-backend 'crop str)
       str))
 
@@ -913,11 +934,7 @@ can retrieve meta-data for them."
           (unless (company-call-backend 'sorted)
             (setq candidates (sort candidates 'string<)))
           (when (company-call-backend 'duplicates)
-            ;; strip duplicates
-            (let ((c2 candidates))
-              (while c2
-                (setcdr c2 (progn (while (equal (pop c2) (car c2)))
-                                  c2)))))))
+            (company--strip-duplicates candidates))))
     (setq candidates (company--transform-candidates candidates))
     (when candidates
       (if (or (cdr candidates)
@@ -927,6 +944,25 @@ can retrieve meta-data for them."
         ;; Already completed and unique; don't start.
         t))))
 
+(defun company--strip-duplicates (candidates)
+  (let ((c2 candidates))
+    (while c2
+      (setcdr c2
+              (let ((str (car c2))
+                    (anno 'unk))
+                (pop c2)
+                (while (let ((str2 (car c2)))
+                         (if (not (equal str str2))
+                             nil
+                           (when (eq anno 'unk)
+                             (setq anno (company-call-backend
+                                         'annotation str)))
+                           (equal anno
+                                  (company-call-backend
+                                   'annotation str2))))
+                  (pop c2))
+                c2)))))
+
 (defun company--transform-candidates (candidates)
   (let ((c candidates))
     (dolist (tr company-transformers)
@@ -1593,7 +1629,7 @@ To show the number next to the candidates in some 
back-ends, enable
 
 (defun company-fetch-metadata ()
   (let ((selected (nth company-selection company-candidates)))
-    (unless (equal selected (car company-last-metadata))
+    (unless (eq selected (car company-last-metadata))
       (setq company-last-metadata
             (cons selected (company-call-backend 'meta selected))))
     (cdr company-last-metadata)))
@@ -1774,20 +1810,16 @@ 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)
-  (let* ((margin company-tooltip-margin)
-         (common (+ (or (company-call-backend 'common-part line)
-                        (length company-common)) margin)))
-    (setq line (concat (company-space-string company-tooltip-margin)
-                       (company-safe-substring
-                        line 0 (+ width company-tooltip-margin)))
-          width (+ width (* 2 margin)))
+(defun company-fill-propertize (value annotation width selected left right)
+  (let* ((margin (length left))
+         (common (+ (or (company-call-backend 'common-part value)
+                        (length company-common)) margin))
+         (ann-start (+ margin (length value)))
+         (line (concat left
+                       (company-safe-substring (concat value annotation)
+                                               0 width)
+                       right)))
+    (setq width (+ width margin (length right)))
 
     (add-text-properties 0 width '(face company-tooltip
                                    mouse-face company-tooltip-mouse)
@@ -1796,16 +1828,20 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
                          '(face company-tooltip-common
                            mouse-face company-tooltip-mouse)
                          line)
+    (add-text-properties ann-start (+ ann-start (length annotation))
+                         '(face company-tooltip-annotation
+                           mouse-face company-tooltip-mouse)
+                         line)
     (when selected
       (if (and company-search-string
-               (string-match (regexp-quote company-search-string) line
+               (string-match (regexp-quote company-search-string) value
                              (length company-prefix)))
-          (progn
-            (add-text-properties (match-beginning 0) (match-end 0)
-                                 '(face company-tooltip-selection)
+          (let ((beg (+ margin (match-beginning 0)))
+                (end (+ margin (match-end 0))))
+            (add-text-properties beg end '(face company-tooltip-selection)
                                  line)
-            (when (< (match-beginning 0) common)
-              (add-text-properties (match-beginning 0) common
+            (when (< beg common)
+              (add-text-properties beg common
                                    '(face company-tooltip-common-selection)
                                    line)))
         (add-text-properties 0 width '(face company-tooltip-selection
@@ -1814,8 +1850,8 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
         (add-text-properties margin common
                              '(face company-tooltip-common-selection
                                mouse-face company-tooltip-selection)
-                             line))))
-  line)
+                             line)))
+    line))
 
 ;;; replace
 
@@ -1888,17 +1924,16 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     line))
 
 (defun company--create-lines (selection limit)
-
   (let ((len company-candidates-length)
         (numbered 99999)
         (window-width (company--window-width))
         lines
         width
         lines-copy
+        items
         previous
         remainder
-        scrollbar-bounds
-        new)
+        scrollbar-bounds)
 
     ;; Maybe clear old offset.
     (when (<= len (+ company-tooltip-offset limit))
@@ -1930,40 +1965,49 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     (when scrollbar-bounds (decf window-width))
 
     (dotimes (_ len)
-      (setq width (max (length (pop lines-copy)) width)))
+      (let* ((value (pop lines-copy))
+             (annotation (company-call-backend 'annotation value)))
+        (push (cons value annotation) items)
+        (setq width (max (+ (length value) (length annotation)) width))))
+
     (setq width (min window-width
                      (if (and company-show-numbers
                               (< company-tooltip-offset 10))
                          (+ 2 width)
                        width)))
-    (setq lines-copy lines)
 
     ;; number can make tooltip too long
     (when company-show-numbers
       (setq numbered company-tooltip-offset))
 
-    (when previous
-      (push (company--scrollpos-line previous width) new))
-
-    (dotimes (i len)
-      (let ((line (company-fill-propertize
-                   (if (>= numbered 10)
-                       (company-reformat (pop lines))
-                     (incf numbered)
-                     (format "%s %d"
-                             (company-safe-substring
-                              (company-reformat (pop lines)) 0 (- width 2))
-                             (mod numbered 10)))
-                   width (equal i selection))))
-        (push (if scrollbar-bounds
-                  (company--scrollbarize line i scrollbar-bounds)
-                line)
-              new)))
-
-    (when remainder
-      (push (company--scrollpos-line remainder width) new))
-
-    (setq lines (nreverse new))))
+    (let ((items (nreverse items)) new)
+      (when previous
+        (push (company--scrollpos-line previous width) new))
+
+      (dotimes (i len)
+        (let* ((item (pop items))
+               (str (company-reformat (car item)))
+               (annotation (cdr item))
+               (right (company-space-string company-tooltip-margin))
+               (width width))
+          (when (< numbered 10)
+            (decf width 2)
+            (incf numbered)
+            (setq right (concat (format " %d" (mod numbered 10)) right)))
+          (push (concat
+                 (company-fill-propertize str annotation
+                                          width (equal i selection)
+                                          (company-space-string
+                                           company-tooltip-margin)
+                                          right)
+                 (when scrollbar-bounds
+                   (company--scrollbar i scrollbar-bounds)))
+                new)))
+
+      (when remainder
+        (push (company--scrollpos-line remainder width) new))
+
+      (nreverse new))))
 
 (defun company--scrollbar-bounds (offset limit length)
   (when (> length limit)
@@ -1972,12 +2016,11 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
            (upper (+ lower size -1)))
       (cons lower upper))))
 
-(defun company--scrollbarize (line i bounds)
-  (concat line
-          (propertize " " 'face
-                      (if (and (>= i (car bounds)) (<= i (cdr bounds)))
-                          'company-scrollbar-fg
-                        'company-scrollbar-bg))))
+(defun company--scrollbar (i bounds)
+  (propertize " " 'face
+              (if (and (>= i (car bounds)) (<= i (cdr bounds)))
+                  'company-scrollbar-fg
+                'company-scrollbar-bg)))
 
 (defun company--scrollpos-line (text width)
   (propertize (concat (company-space-string company-tooltip-margin)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]