[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)
- [elpa] 17/21: company-capf: strip duplicates, (continued)
- [elpa] 17/21: company-capf: strip duplicates, Dmitry Gutov, 2014/02/03
- [elpa] 01/21: company-begin-commands: add `org-self-insert-command', Dmitry Gutov, 2014/02/03
- [elpa] 21/21: Merge commit '67ab56a5469f16652e73667ec3b4f76ff6befee6' from company, Dmitry Gutov, 2014/02/03
- [elpa] 16/21: Don't "transform" twice, Dmitry Gutov, 2014/02/03
- [elpa] 20/21: Remove outdated comment, Dmitry Gutov, 2014/02/03
- [elpa] 02/21: Make dabbrev and dabbrev-code more customizable, Dmitry Gutov, 2014/02/03
- [elpa] 19/21: Fix #56, Dmitry Gutov, 2014/02/03
- [elpa] 04/21: Add company-transformers, Dmitry Gutov, 2014/02/03
- [elpa] 14/21: company-sort-by-occurrence: consider the preceding line, Dmitry Gutov, 2014/02/03
- [elpa] 13/21: company--continue-failed: require matching input properly, Dmitry Gutov, 2014/02/03
- [elpa] 18/21: Display annotations,
Dmitry Gutov <=