[elpa] 05/31: Add user option company-tooltip-align-annotations

[Dmitry Gutov]

dgutov pushed a commit to branch master
in repository elpa.

commit 6862904ddb6b8b11eb469f37e13dc0c1011b1e76
Author: Dmitry Gutov <address@hidden>
Date:   Thu Feb 20 23:09:22 2014 +0200

    Add user option company-tooltip-align-annotations
    
    Closes #63
---
 NEWS.md          |    3 ++-
 company-tests.el |   34 +++++++++++++++++++++++++++++++---
 company.el       |   36 ++++++++++++++++++++++++++++++++----
 3 files changed, 65 insertions(+), 8 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 15739d3..1552686 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,7 +2,8 @@
 
 ## Next
 
-* New bundled back-end, `company-bbdb`.
+* New user option `company-tooltip-align-annotations`, on by default.
+* New bundled back-end `company-bbdb`.
 
 ## 2014-02-18 (0.7)
 
diff --git a/company-tests.el b/company-tests.el
index 8b56fec..2f8e51b 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -319,7 +319,8 @@
             (company-backend (lambda (action &optional arg &rest _ignore)
                                (when (eq action 'annotation)
                                  (cdr (assoc arg '(("123" . "(4)")))))))
-            (company-candidates '("123" "45")))
+            (company-candidates '("123" "45"))
+            company-tooltip-align-annotations)
         (company-pseudo-tooltip-show-at-point (point))
         (let ((ov company-pseudo-tooltip-overlay))
           ;; With margins.
@@ -327,6 +328,27 @@
           (should (string= (overlay-get ov 'company-after)
                            " 123(4) \n 45     \n")))))))
 
+(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
+  :tags '(interactive)
+  (with-temp-buffer
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (insert " ")
+      (save-excursion (insert "\n"))
+      (let ((company-candidates-length 3)
+            (company-backend (lambda (action &optional arg &rest _ignore)
+                               (when (eq action 'annotation)
+                                 (cdr (assoc arg '(("123" . "(4)")
+                                                   ("67" . "(891011)")))))))
+            (company-candidates '("123" "45" "67"))
+            (company-tooltip-align-annotations t))
+        (company-pseudo-tooltip-show-at-point (point))
+        (let ((ov company-pseudo-tooltip-overlay))
+          ;; With margins.
+          (should (eq (overlay-get ov 'company-width) 13))
+          (should (string= (overlay-get ov 'company-after)
+                           " 123     (4) \n 45          \n 67 (891011) 
\n")))))))
+
 (ert-deftest company-create-lines-shows-numbers ()
   (let ((company-show-numbers t)
         (company-candidates '("x" "y" "z"))
@@ -344,11 +366,17 @@
          (company-tooltip-margin 1)
          (company-backend (lambda (cmd &optional arg)
                             (when (eq cmd 'annotation)
-                              (cdr (assoc arg data))))))
+                              (cdr (assoc arg data)))))
+         company-tooltip-align-annotations)
     (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
                          (format " 2%s " (company-space-string (- ww 3)))
                          (format " 3(444%s " (make-string (- ww 7) ?4)))
-                   (company--create-lines 0 999)))))
+                   (company--create-lines 0 999)))
+    (let ((company-tooltip-align-annotations t))
+      (should (equal (list (format " 1%s(123) " (company-space-string (- ww 
8)))
+                           (format " 2%s " (company-space-string (- ww 3)))
+                           (format " 3 (444%s " (make-string (- ww 8) ?4)))
+                     (company--create-lines 0 999))))))
 
 (ert-deftest company-column-with-composition ()
   (with-temp-buffer
diff --git a/company.el b/company.el
index 2814ab7..de0a996 100644
--- a/company.el
+++ b/company.el
@@ -254,6 +254,10 @@ If this many lines are not available, prefer to display 
the tooltip above."
   :type '(choice (const :tag "Scrollbar" scrollbar)
                  (const :tag "Two lines" lines)))
 
+(defcustom company-tooltip-align-annotations t
+  "When non-nil, align annotations to the right tooltip border."
+  :type 'boolean)
+
 (defvar company-safe-backends
   '((company-abbrev . "Abbrev")
     (company-bbdb . "BBDB")
@@ -1856,10 +1860,27 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
   (let* ((margin (length left))
          (common (+ (or (company-call-backend 'match value)
                         (length company-common)) margin))
-         (ann-start (+ margin (length value)))
+         (ann-ralign company-tooltip-align-annotations)
+         (ann-truncate (< width
+                          (+ (length value) (length annotation)
+                             (if ann-ralign 1 0))))
+         (ann-start (+ margin
+                       (if ann-ralign
+                           (if ann-truncate
+                               (1+ (length value))
+                             (- width (length annotation)))
+                         (length value))))
          (line (concat left
-                       (company-safe-substring (concat value annotation)
-                                               0 width)
+                       (if (or ann-truncate (not ann-ralign))
+                           (company-safe-substring
+                            (concat value
+                                    (when (and annotation ann-ralign) " ")
+                                    annotation)
+                            0 width)
+                         (concat
+                          (company-safe-substring value 0
+                                                  (- width (length 
annotation)))
+                          annotation))
                        right)))
     (setq width (+ width margin (length right)))
 
@@ -2009,8 +2030,15 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     (dotimes (_ len)
       (let* ((value (pop lines-copy))
              (annotation (company-call-backend 'annotation value)))
+        (when (and annotation company-tooltip-align-annotations)
+          ;; `lisp-completion-at-point' adds a space.
+          (setq annotation (comment-string-strip annotation t nil)))
         (push (cons value annotation) items)
-        (setq width (max (+ (length value) (length annotation)) width))))
+        (setq width (max (+ (length value)
+                            (if (and annotation 
company-tooltip-align-annotations)
+                                (1+ (length annotation))
+                              (length annotation)))
+                         width))))
 
     (setq width (min window-width
                      (if (and company-show-numbers