[ELPA-diffs] [elpa] 02/12: Render the popup with margins

[Dmitry Gutov]

dgutov pushed a commit to branch master
in repository elpa.

commit 62ae2df8ac19ec1c437ece3b7f46bf107fb9e058
Author: Dmitry Gutov <address@hidden>
Date:   Thu Jan 23 06:38:34 2014 +0200

    Render the popup with margins
---
 NEWS.md          |    5 ++++
 company-tests.el |    9 ++++---
 company.el       |   63 +++++++++++++++++++++++++++++++++++++++--------------
 3 files changed, 56 insertions(+), 21 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 314b1eb..49215fe 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,10 @@
 # History of user-visible changes
 
+## Next
+
+* The tooltip front-end is rendered with margins, controlled by the user option
+  `company-tooltip-margin`.
+
 ## 2014-01-14 (0.6.13)
 
 * Experimental support for non-prefix completion.
diff --git a/company-tests.el b/company-tests.el
index e9116b2..d0b6c7b 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -237,25 +237,26 @@
   (with-temp-buffer
     (save-window-excursion
     (set-window-buffer nil (current-buffer))
-    (insert "aaaa\n bb\nccccc\nddd")
+    (insert "aaaa\n  bb\nccccccc\nddd")
     (search-backward "bb")
     (let ((col (company--column))
           (company-candidates-length 2)
           (company-candidates '("123" "45")))
       (company-pseudo-tooltip-show (company--row) col 0)
       (let ((ov company-pseudo-tooltip-overlay))
-        (should (eq (overlay-get ov 'company-width) 3))
+        ;; With margins.
+        (should (eq (overlay-get ov 'company-width) 5))
         ;; FIXME: Make it 2?
         (should (eq (overlay-get ov 'company-height) company-tooltip-limit))
         (should (eq (overlay-get ov 'company-column) col))
         (should (string= (overlay-get ov 'company-after)
-                         " 123\nc45 c\nddd\n")))))))
+                         "  123 \nc 45  c\nddd\n")))))))
 
 (ert-deftest company-create-lines-shows-numbers ()
   (let ((company-show-numbers t)
         (company-candidates '("x" "y" "z"))
         (company-candidates-length 3))
-    (should (equal '("x 1" "y 2" "z 3")
+    (should (equal '(" x 1 " " y 2 " " z 3 ")
                    (company--create-lines 0 999)))))
 
 (ert-deftest company-column-with-composition ()
diff --git a/company.el b/company.el
index 165ac64..89e0256 100644
--- a/company.el
+++ b/company.el
@@ -211,6 +211,10 @@ The visualized data is stored in `company-prefix', 
`company-candidates',
 If this many lines are not available, prefer to display the tooltip above."
   :type 'integer)
 
+(defcustom company-tooltip-margin 1
+  "Width of margin columns to show around the toolip."
+  :type 'integer)
+
 (defvar company-safe-backends
   '((company-abbrev . "Abbrev")
     (company-capf . "completion-at-point-functions")
@@ -1689,14 +1693,20 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     (add-text-properties 0 common properties line)))
 
 (defun company-fill-propertize (line width selected)
-  (let ((common (or (company-call-backend 'common-part line)
-                    (length company-common))))
-    (setq line (company-safe-substring line 0 width))
+  (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)))
+
     (add-text-properties 0 width '(face company-tooltip
                                    mouse-face company-tooltip-mouse)
                          line)
-    (add-text-properties 0 common '(face company-tooltip-common
-                                    mouse-face company-tooltip-mouse)
+    (add-text-properties margin common
+                         '(face company-tooltip-common
+                           mouse-face company-tooltip-mouse)
                          line)
     (when selected
       (if (and company-search-string
@@ -1713,8 +1723,9 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
         (add-text-properties 0 width '(face company-tooltip-selection
                                        mouse-face company-tooltip-selection)
                              line)
-        (add-text-properties 0 common '(face company-tooltip-common-selection
-                                        mouse-face company-tooltip-selection)
+        (add-text-properties margin common
+                             '(face company-tooltip-common-selection
+                               mouse-face company-tooltip-selection)
                              line))))
   line)
 
@@ -1750,6 +1761,7 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     (length lst)))
 
 (defun company--replacement-string (lines old column nl &optional align-top)
+  (decf column company-tooltip-margin)
 
   (let ((width (length (car lines)))
         (remaining-cols (- (+ (company--window-width) (window-hscroll))
@@ -1757,17 +1769,24 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
     (when (> width remaining-cols)
       (decf column (- width remaining-cols))))
 
-  (let (new)
+  (let ((cutoff (and (< column 0) (- column)))
+        new)
+    (when cutoff
+      (setq column 0))
     (when align-top
       ;; untouched lines first
       (dotimes (_ (- (length old) (length lines)))
         (push (pop old) new)))
     ;; length into old lines.
     (while old
-      (push (company-modify-line (pop old) (pop lines) column) new))
+      (push (company-modify-line (pop old)
+                                 (company--cutoff-line (pop lines) cutoff)
+                                 column) new))
     ;; Append whole new lines.
     (while lines
-      (push (concat (company-space-string column) (pop lines)) new))
+      (push (concat (company-space-string column)
+                    (company--cutoff-line (pop lines) cutoff))
+            new))
 
     (let ((str (concat (when nl "\n")
                        (mapconcat 'identity (nreverse new) "\n")
@@ -1775,10 +1794,16 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
       (font-lock-append-text-property 0 (length str) 'face 'default str)
       str)))
 
+(defun company--cutoff-line (line cutoff)
+  (if (and cutoff line)
+      (substring line cutoff)
+    line))
+
 (defun company--create-lines (selection limit)
 
   (let ((len company-candidates-length)
         (numbered 99999)
+        (window-width (company--window-width))
         lines
         width
         lines-copy
@@ -1802,9 +1827,11 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
           len (min limit len)
           lines-copy lines)
 
+    (decf window-width (* 2 company-tooltip-margin))
+
     (dotimes (_ len)
       (setq width (max (length (pop lines-copy)) width)))
-    (setq width (min (company--window-width)
+    (setq width (min window-width
                      (if company-show-numbers
                          (+ 2 width)
                        width)))
@@ -1815,9 +1842,7 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
       (setq numbered company-tooltip-offset))
 
     (when previous
-      (push (propertize (company-safe-substring previous 0 width)
-                        'face 'company-tooltip)
-            new))
+      (push (company--numbered-line previous width) new))
 
     (dotimes (i len)
       (push (company-fill-propertize
@@ -1832,12 +1857,16 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\" 
\"foobarbaz\"\)\)"
             new))
 
     (when remainder
-      (push (propertize (company-safe-substring remainder 0 width)
-                        'face 'company-tooltip)
-            new))
+      (push (company--numbered-line remainder width) new))
 
     (setq lines (nreverse new))))
 
+(defun company--numbered-line (text width)
+  (concat (company-space-string company-tooltip-margin)
+          (propertize (company-safe-substring text 0 width)
+                      'face 'company-tooltip)
+          (company-space-string company-tooltip-margin)))
+
 ;; show
 
 (defsubst company--window-inner-height ()