dgutov pushed a commit to branch master
in repository elpa.
commit d16ae1619788ed9226b9bc1d0476d6350b8638b2
Author: Dmitry Gutov <dgu...@yandex.ru>
Date: Fri Jan 24 07:04:39 2014 +0200
Render scrollbar on the side of the tooltip
Closes #48
---
NEWS.md | 2 +
company-tests.el | 11 +++++-
company.el | 99 +++++++++++++++++++++++++++++++++++++++++------------
3 files changed, 88 insertions(+), 24 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index 49215fe..737a3e1 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,8 @@
## Next
+* The tooltip front-end is rendered with scrollbar, controlled by the user
+ option `company-tooltip-offset-display`.
* The tooltip front-end is rendered with margins, controlled by the user option
`company-tooltip-margin`.
diff --git a/company-tests.el b/company-tests.el
index d0b6c7b..b986e9b 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -1,6 +1,6 @@
;;; company-tests.el --- company-mode tests
-;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -301,6 +301,15 @@
(company-modify-line str "zz" 10)
"-*-foobar zz"))))
+(ert-deftest company-scrollbar-bounds ()
+ (should (equal nil (company--scrollbar-bounds 0 3 3)))
+ (should (equal nil (company--scrollbar-bounds 0 4 3)))
+ (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
+ (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
+ (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
+ (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
+ (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
+
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
diff --git a/company.el b/company.el
index 27343fa..d7b96c5 100644
--- a/company.el
+++ b/company.el
@@ -123,6 +123,21 @@
:foreground "red"))
"Face used for the selected common completion in the tooltip.")
+(defface company-scrollbar-fg
+ '((((background light))
+ :background "darkred")
+ (((background dark))
+ :background "red"))
+ "Face used for the tooltip scrollbar thumb.")
+
+(defface company-scrollbar-bg
+ '((default :inherit company-tooltip)
+ (((background light))
+ :background "wheat")
+ (((background dark))
+ :background "gold"))
+ "Face used for the tooltip scrollbar background.")
+
(defface company-preview
'((t :background "blue4"
:foreground "wheat"))
@@ -215,6 +230,13 @@ If this many lines are not available, prefer to display
the tooltip above."
"Width of margin columns to show around the toolip."
:type 'integer)
+(defcustom company-tooltip-offset-display 'scrollbar
+ "Method using which the tooltip displays scrolling position.
+`scrollbar' means draw a scrollbar to the right of the items.
+`lines' means wrap items in lines with \"before\" and \"after\" counters."
+ :type '(choice (const :tag "Scrollbar" scrollbar)
+ (const :tag "Two lines" lines)))
+
(defvar company-safe-backends
'((company-abbrev . "Abbrev")
(company-capf . "completion-at-point-functions")
@@ -1647,8 +1669,7 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
(defvar company-tooltip-offset 0)
(make-variable-buffer-local 'company-tooltip-offset)
-(defun company-pseudo-tooltip-update-offset (selection num-lines limit)
-
+(defun company-tooltip--lines-update-offset (selection num-lines limit)
(decf limit 2)
(setq company-tooltip-offset
(max (min selection company-tooltip-offset)
@@ -1668,6 +1689,13 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
limit)
+(defun company-tooltip--simple-update-offset (selection num-lines limit)
+ (setq company-tooltip-offset
+ (if (< selection company-tooltip-offset)
+ selection
+ (max company-tooltip-offset
+ (- selection limit -1)))))
+
;;; propertize
(defsubst company-round-tab (arg)
@@ -1809,17 +1837,24 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
lines-copy
previous
remainder
+ scrollbar-bounds
new)
;; Scroll to offset.
- (setq limit (company-pseudo-tooltip-update-offset selection len limit))
-
- (when (> company-tooltip-offset 0)
- (setq previous (format "...(%d)" company-tooltip-offset)))
-
- (setq remainder (- len limit company-tooltip-offset)
- remainder (when (> remainder 0)
- (setq remainder (format "...(%d)" remainder))))
+ (if (eq company-tooltip-offset-display 'lines)
+ (setq limit (company-tooltip--lines-update-offset selection len limit))
+ (company-tooltip--simple-update-offset selection len limit))
+
+ (cond
+ ((eq company-tooltip-offset-display 'scrollbar)
+ (setq scrollbar-bounds (company--scrollbar-bounds company-tooltip-offset
+ limit len)))
+ ((eq company-tooltip-offset-display 'lines)
+ (when (> company-tooltip-offset 0)
+ (setq previous (format "...(%d)" company-tooltip-offset)))
+ (setq remainder (- len limit company-tooltip-offset)
+ remainder (when (> remainder 0)
+ (setq remainder (format "...(%d)" remainder))))))
(decf selection company-tooltip-offset)
(setq width (max (length previous) (length remainder))
@@ -1828,6 +1863,7 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
lines-copy lines)
(decf window-width (* 2 company-tooltip-margin))
+ (when scrollbar-bounds (decf window-width))
(dotimes (_ len)
(setq width (max (length (pop lines-copy)) width)))
@@ -1842,26 +1878,43 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
(setq numbered company-tooltip-offset))
(when previous
- (push (company--position-line previous width) new))
+ (push (company--scrollpos-line previous width) new))
(dotimes (i len)
- (push (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))
- new))
+ (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--position-line remainder width) new))
+ (push (company--scrollpos-line remainder width) new))
(setq lines (nreverse new))))
-(defun company--position-line (text width)
+(defun company--scrollbar-bounds (offset limit length)
+ (when (> length limit)
+ (let* ((size (ceiling (* limit (float limit)) length))
+ (lower (floor (* limit (float offset)) length))
+ (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--scrollpos-line (text width)
(propertize (concat (company-space-string company-tooltip-margin)
(company-safe-substring text 0 width)
(company-space-string company-tooltip-margin))
