branch: externals/company
commit 1116da817131ff6b27ee35aa77fe9aafb8d9c365
Merge: 534273d 4ce6c58
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
Merge branch 'master' into default-bindings-change
---
NEWS.md | 17 +++-
company-abbrev.el | 3 +-
company-files.el | 13 ++-
company-tng.el | 4 +-
company.el | 255 +++++++++++++++++++++++++++++++-----------------
test/frontends-tests.el | 4 +-
6 files changed, 196 insertions(+), 100 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index 4aa7ebc..ed68cc7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,7 +2,7 @@
## Next
-* Default key bindings have changed, moving `company-select-next` and
+* Default key bindings have been changed, moving `company-select-next` and
`company-select-previous` from `M-n` and `M-p` to `C-n` and `C-p`. The
previous bindings still work, but show a warning and will be disabled soon.
To
undo that change in your local configuration, do:
@@ -16,13 +16,20 @@
(define-key map (kbd "M-p") 'company-select-previous)))
```
+* New user option `company-files-chop-trailing-slash`
+ ([#1042](https://github.com/company-mode/company-mode/issues/1042)).
+* Improved visual responsiveness with async backends
+ ([#1073](https://github.com/company-mode/company-mode/issues/1073)). New user
+ option `company-async-redisplay-delay`.
* `company-idle-delay` default reduced to 0.2 (seconds).
* The minimum required version of Emacs is now 25.1.
* Added support for icons
- ([#1070](https://github.com/company-mode/company-mode/pull/1070)), disabled
by
- default. New user option `company-format-margin-function`. New backend
command
- `kind`. Both built-in options for `company-format-margin-function` require
- Emacs compiled with SVG support.
+ ([#1070](https://github.com/company-mode/company-mode/pull/1070)).
+ New user option `company-format-margin-function`. New backend command
+ `kind`. There are two built-in SVG icon sets, one for light and another for
+ dark icons. The default behavior is to choose the best one for the current
+ theme automatically, or if the current frame is non-graphical or simply does
+ not support rendering SVG images, fall back to text-based "icons".
* New user option `company-abort-on-unique-match`
([#1046](https://github.com/company-mode/company-mode/issues/1046)).
* `company-select-mouse` is a new frontend action
diff --git a/company-abbrev.el b/company-abbrev.el
index 386feb6..16722dd 100644
--- a/company-abbrev.el
+++ b/company-abbrev.el
@@ -1,6 +1,6 @@
;;; company-abbrev.el --- company-mode completion backend for abbrev
-;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2015, 2021 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -44,6 +44,7 @@
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
+ (kind 'snippet)
(meta (abbrev-expansion arg))))
(provide 'company-abbrev)
diff --git a/company-files.el b/company-files.el
index 88da2bf..902ea5e 100644
--- a/company-files.el
+++ b/company-files.el
@@ -1,6 +1,6 @@
;;; company-files.el --- company-mode completion backend for file names
-;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2014-2021 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -38,6 +38,14 @@ The values should use the same format as
`completion-ignored-extensions'."
:type '(const string)
:package-version '(company . "0.9.1"))
+(defcustom company-files-chop-trailing-slash t
+ "Non-nil to remove the trailing slash after inserting directory name.
+
+This way it's easy to continue completion by typing `/' again.
+
+Set this to nil to disable that behavior."
+ :type 'boolean)
+
(defun company-files--directory-files (dir prefix)
;; Don't use directory-files. It produces directories without trailing /.
(condition-case err
@@ -128,7 +136,8 @@ The values should use the same format as
`completion-ignored-extensions'."
(string-prefix-p (car old) (car new))))
(defun company-files--post-completion (arg)
- (when (company-files--trailing-slash-p arg)
+ (when (and company-files-chop-trailing-slash
+ (company-files--trailing-slash-p arg))
(delete-char -1)))
;;;###autoload
diff --git a/company-tng.el b/company-tng.el
index 59e466f..55124a3 100644
--- a/company-tng.el
+++ b/company-tng.el
@@ -179,7 +179,9 @@ confirm the selection and finish the completion."
(setq company-selection-default nil))
(t
(setq company-frontends
- (delete 'company-tng-frontend company-frontends))
+ '(company-pseudo-tooltip-unless-just-one-frontend
+ company-preview-if-just-one-frontend
+ company-echo-metadata-frontend))
(when company-tng-auto-configure
(setq company-require-match 'company-explicit-action-p
company-clang-insert-arguments t
diff --git a/company.el b/company.el
index 2c3d2dc..89b9165 100644
--- a/company.el
+++ b/company.el
@@ -224,6 +224,10 @@ visualization is active.
`post-command': After every command that is executed while the
visualization is active.
+`unhide': When an asynchronous backend is waiting for its completions.
+Only needed in frontends which hide their visualizations in `pre-command'
+for technical reasons.
+
The visualized data is stored in `company-prefix', `company-candidates',
`company-common', `company-selection', `company-point' and
`company-search-string'."
@@ -673,6 +677,13 @@ return a string prefixed with one space."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)))
+(defcustom company-async-redisplay-delay 0.005
+ "Delay before redisplay when fetching candidates asynchronously.
+
+You might want to set this to a higher value if your backends respond
+quickly, to avoid redisplaying twice per each typed character."
+ :type 'number)
+
(defvar company-async-wait 0.03
"Pause between checks to see if the value's been set when turning an
asynchronous call into synchronous.")
@@ -1275,10 +1286,13 @@ update if FORCE-UPDATE."
company-candidates-cache)))
(setq candidates (all-completions prefix prev))
(cl-return t)))))
- (progn
- ;; No cache match, call the backend.
+ ;; No cache match, call the backend.
+ (let ((refresh-timer (run-with-timer company-async-redisplay-delay
+ nil #'company--sneaky-refresh)))
(setq candidates (company--preprocess-candidates
(company--fetch-candidates prefix)))
+ ;; If the backend is synchronous, no chance for the timer to run.
+ (cancel-timer refresh-timer)
;; Save in cache.
(push (cons prefix candidates) company-candidates-cache)))
;; Only now apply the predicate and transformers.
@@ -1321,6 +1335,12 @@ update if FORCE-UPDATE."
(and (consp res) res)
(setq res 'exited))))))
+(defun company--sneaky-refresh ()
+ (when company-candidates (company-call-frontends 'unhide))
+ (let (inhibit-redisplay)
+ (redisplay))
+ (when company-candidates (company-call-frontends 'pre-command)))
+
(defun company--flyspell-workaround-p ()
;; https://debbugs.gnu.org/23980
(and (bound-and-true-p flyspell-mode)
@@ -1438,6 +1458,7 @@ end of the match."
'company-tooltip-selection
'company-tooltip)
:background))
+ (dfw (default-font-width))
(icon-size (cond
((integerp company-icon-size)
company-icon-size)
@@ -1445,11 +1466,13 @@ end of the match."
;; (aref (font-info (face-font 'default)) 2)
((and (consp company-icon-size)
(eq 'auto-scale (car company-icon-size)))
- (let ((base-size (cdr company-icon-size)))
- (if (> (default-font-height)
- (* 2 base-size))
- (* 2 base-size)
- base-size)))))
+ (let ((base-size (cdr company-icon-size))
+ (dfh (default-font-height)))
+ (min
+ (if (> dfh (* 2 base-size))
+ (* 2 base-size)
+ base-size)
+ (* 2 dfw))))))
(spec (list 'image
:file (expand-file-name icon-file root-dir)
:type 'svg
@@ -1457,10 +1480,11 @@ end of the match."
:height icon-size
:ascent 'center
:background (unless (eq bkg 'unspecified)
- bkg))))
+ bkg)))
+ (spacer-px-width (- (* 2 dfw) icon-size)))
(concat
(propertize " " 'display spec)
- (propertize " " 'display `(space . (:width ,(- 2 (car (image-size
spec))))))))
+ (propertize " " 'display `(space . (:width (,spacer-px-width))))))
nil))
(defun company-vscode-dark-icons-margin (candidate selected)
@@ -1478,105 +1502,149 @@ end of the match."
selected))
(defcustom company-text-icons-mapping
- '((array . "Α")
- (boolean . "β")
- (class . "γ")
- (color . "Δ")
- (constant . "ε")
- (enum-member . "ζ")
- (enum . "Ζ")
- (event . "η")
- (field . "θ")
- (file . "Ɩ")
- (folder . "⍳")
- (interface . "ϰ")
- (keyword . "ν")
- (method . "λ")
- (function . "ƒ")
- (module . "Ο")
- (numeric . "π")
- (operator . "⊙")
- (parameter . "ρ")
- (property . "σ")
- (ruler . "τ")
- (snippet . "υ")
- (string . "φ")
- (struct . "Χ")
- (text . "μ")
- (value . "Ζ")
- (variable . "ѱ")
- (t . "ξ"))
- "Mapping of the text icons."
+ '((array "a" font-lock-type-face)
+ (boolean "b" font-lock-builtin-face)
+ (class "c" font-lock-type-face)
+ (color "#" success)
+ (constant "c" font-lock-constant-face)
+ (enum-member "e" font-lock-builtin-face)
+ (enum "e" font-lock-builtin-face)
+ (field "f" font-lock-variable-name-face)
+ (file "f" font-lock-string-face)
+ (folder "d" font-lock-doc-face)
+ (interface "i" font-lock-type-face)
+ (keyword "k" font-lock-keyword-face)
+ (method "m" font-lock-function-name-face)
+ (function "f" font-lock-function-name-face)
+ (module "{" font-lock-type-face)
+ (numeric "n" font-lock-builtin-face)
+ (operator "o" font-lock-comment-delimiter-face)
+ (parameter "p" font-lock-builtin-face)
+ (property "p" font-lock-variable-name-face)
+ (ruler "r" shadow)
+ (snippet "S" font-lock-string-face)
+ (string "s" font-lock-string-face)
+ (struct "%" font-lock-variable-name-face)
+ (text "w" shadow)
+ (value "v" font-lock-builtin-face)
+ (variable "v" font-lock-variable-name-face)
+ (t "." shadow))
+ "Mapping of the text icons.
+The format should be an alist of (KIND . CONF) where CONF is a list of the
+form (ICON FG BG) which is used to propertize the icon to be shown for a
+candidate of kind KIND. FG can either be color string or a face from which
+we can get a color string (using the :foreground face-property). BG must be
+of the same form as FG or a cons cell of (BG . BG-WHEN-SELECTED) which each
+should be of the same form as FG.
+
+The only mandatory element in CONF is ICON, you can omit both the FG and BG
+fields without issue.
+
+When BG is omitted and `company-text-icons-add-background' is non-nil, a BG
+color will be generated using a gradient between the active tooltip color and
+the FG color."
+ :type 'list)
+
+(defcustom company-text-face-extra-attributes '(:weight bold)
+ "Additional attributes to add to text icons' faces.
+If non-nil, an anonymous face will be generated.
+Only affects `company-text-icons-margin'."
:type 'list)
-(defcustom company-text-icons-format "%s "
+(defcustom company-text-icons-format " %s "
"Format string for printing the text icons."
:type 'string)
-(defun company-text-icons-margin (candidate _selected)
+(defcustom company-text-icons-add-background nil
+ "When non-nil, generate a background color for text icons when none is given.
+See `company-text-icons-mapping'."
+ :type 'boolean)
+
+(defun company-text-icons-margin (candidate selected)
"Margin function which returns unicode icons."
(when-let ((candidate candidate)
(kind (company-call-backend 'kind candidate))
- (icon (or (alist-get kind company-text-icons-mapping)
+ (conf (or (alist-get kind company-text-icons-mapping)
(alist-get t company-text-icons-mapping))))
- (format company-text-icons-format icon)))
+ (cl-destructuring-bind (icon &optional fg bg) conf
+ (propertize
+ (format company-text-icons-format icon)
+ 'face
+ (company-text-icons--face fg bg selected)))))
+
+(declare-function color-rgb-to-hex "color")
+(declare-function color-gradient "color")
+
+(defun company-text-icons--extract-property (face property)
+ "Try to extract PROPERTY from FACE.
+If FACE isn't a valid face return FACE as is. If FACE doesn't have
+PROPERTY return nil."
+ (if (facep face)
+ (let ((value (face-attribute face property)))
+ (unless (eq value 'unspecified)
+ value))
+ face))
+
+(defun company-text-icons--face (fg bg selected)
+ (let ((fg-color (company-text-icons--extract-property fg :foreground)))
+ `(,@company-text-face-extra-attributes
+ ,@(and fg-color
+ (list :foreground fg-color))
+ ,@(let* ((bg-is-cons (consp bg))
+ (bg (if bg-is-cons (if selected (cdr bg) (car bg)) bg))
+ (bg-color (company-text-icons--extract-property bg :background))
+ (tooltip-bg-color (company-text-icons--extract-property
+ (if selected
+ 'company-tooltip-selection
+ 'company-tooltip)
+ :background)))
+ (cond
+ ((and company-text-icons-add-background selected
+ (not bg-is-cons) bg-color tooltip-bg-color)
+ ;; Adjust the coloring of the background when *selected* but user
hasn't
+ ;; specified an alternate background color for selected item icons.
+ (list :background
+ (apply #'color-rgb-to-hex
+ (nth 0 (color-gradient (color-name-to-rgb
tooltip-bg-color)
+ (color-name-to-rgb bg-color)
+ 2)))))
+ (bg
+ ;; When background is configured we use it as is, even if it
doesn't
+ ;; constrast well with other candidates when selected.
+ (and bg-color
+ (list :background bg-color)))
+ ((and company-text-icons-add-background fg-color tooltip-bg-color)
+ ;; Lastly attempt to generate a background from the foreground.
+ (list :background
+ (apply #'color-rgb-to-hex
+ (nth 0 (color-gradient (color-name-to-rgb
tooltip-bg-color)
+ (color-name-to-rgb fg-color)
+ 10))))))))))
(defcustom company-dot-icons-format "●"
"Format string for `company-dot-icons-margin'."
:type 'string)
-(defcustom company-dot-icons-face-mapping
- '((array . font-lock-type-face)
- (boolean . font-lock-builtin-face)
- (class . font-lock-type-face)
- (color . success)
- (constant . font-lock-constant-face)
- (enum-member . font-lock-builtin-face)
- (enum . font-lock-builtin-face)
- (field . font-lock-variable-name-face)
- (file . font-lock-string-face)
- (folder . font-lock-doc-face)
- (interface . font-lock-type-face)
- (keyword . font-lock-keyword-face)
- (method . font-lock-function-name-face)
- (function . font-lock-function-name-face)
- (module . font-lock-type-face)
- (numeric . font-lock-builtin-face)
- (operator . font-lock-comment-delimiter-face)
- (parameter . font-lock-builtin-face)
- (property . font-lock-variable-name-face)
- ; (ruler . nil)
- (snippet . font-lock-string-face)
- (string . font-lock-string-face)
- (struct . font-lock-variable-name-face)
- ; (text . nil)
- (value . font-lock-builtin-face)
- (variable . font-lock-variable-name-face)
- (t . deemphasized))
- "Faces mapping for `company-dot-icons-margin'."
- :type '(repeat
- (cons (symbol :tag "Kind name")
- (face :tag "Face to use for it"))))
-
-(defun company-dot-icons-margin (candidate _selected)
+(defun company-dot-icons-margin (candidate selected)
"Margin function that uses a colored dot to display completion kind."
(when-let ((kind (company-call-backend 'kind candidate))
- (face (or (assoc-default kind
- company-dot-icons-face-mapping)
- (assoc-default t company-dot-icons-face-mapping))))
- (propertize company-dot-icons-format 'face face)))
+ (conf (or (assoc-default kind company-text-icons-mapping)
+ (assoc-default t company-text-icons-mapping))))
+ (cl-destructuring-bind (_icon &optional fg bg) conf
+ (propertize company-dot-icons-format
+ 'face
+ (company-text-icons--face fg bg selected)))))
(defun company-detect-icons-margin (candidate selected)
- "Margin function which picks from vscodes icons or unicode icons
-based on `display-graphic-p'."
- (if (display-graphic-p)
- ;; Default to dark because who in their right mind uses light 😜
+ "Margin function which picks the appropriate icon set automatically."
+ (if (and (display-graphic-p)
+ (image-type-available-p 'svg))
(cl-case (frame-parameter nil 'background-mode)
('light (company-vscode-light-icons-margin candidate selected))
(t (company-vscode-dark-icons-margin candidate selected)))
(company-text-icons-margin candidate selected)))
-(defcustom company-format-margin-function nil
+(defcustom company-format-margin-function #'company-detect-icons-margin
"Function to format the margin.
It accepts 2 params `candidate' and `selected' and can be used for
inserting prefix/image before the completion items. Typically, the
@@ -3273,6 +3341,7 @@ Returns a negative number if the tooltip should be
displayed above point."
"`company-mode' frontend similar to a tooltip but based on overlays."
(cl-case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
+ (unhide (company-pseudo-tooltip-unhide))
(post-command
(unless (when (overlayp company-pseudo-tooltip-overlay)
(let* ((ov company-pseudo-tooltip-overlay)
@@ -3315,7 +3384,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(defun company-pseudo-tooltip-unless-just-one-frontend (command)
"`company-pseudo-tooltip-frontend', but not shown for single candidates."
- (unless (and (eq command 'post-command)
+ (unless (and (memq command '(post-command unhide))
(company--show-inline-p))
(company-pseudo-tooltip-frontend command)))
@@ -3398,6 +3467,13 @@ Delay is determined by `company-tooltip-idle-delay'."
"`company-mode' frontend showing the selection as if it had been inserted."
(pcase command
(`pre-command (company-preview-hide))
+ (`unhide
+ (when company-selection
+ (let ((company-prefix (buffer-substring
+ (- company-point (length company-prefix))
+ (point))))
+ (company-preview-show-at-point (point)
+ (nth company-selection
company-candidates)))))
(`post-command
(when company-selection
(company-preview-show-at-point (point)
@@ -3406,7 +3482,7 @@ Delay is determined by `company-tooltip-idle-delay'."
(defun company-preview-if-just-one-frontend (command)
"`company-preview-frontend', but only shown for single candidates."
- (when (or (not (eq command 'post-command))
+ (when (or (not (memq command '(post-command unhide)))
(company--show-inline-p))
(company-preview-frontend command)))
@@ -3432,11 +3508,12 @@ Delay is determined by `company-tooltip-idle-delay'."
(defun company-preview-common-frontend (command)
"`company-mode' frontend preview the common part of candidates."
- (when (or (not (eq command 'post-command))
+ (when (or (not (memq command '(post-command unhide)))
(company-preview-common--show-p))
(pcase command
(`pre-command (company-preview-hide))
- (`post-command (company-preview-show-at-point (point) company-common))
+ ((or 'post-command 'unhide)
+ (company-preview-show-at-point (point) company-common))
(`hide (company-preview-hide)))))
;;; echo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test/frontends-tests.el b/test/frontends-tests.el
index 6b805b0..c08fb7f 100644
--- a/test/frontends-tests.el
+++ b/test/frontends-tests.el
@@ -269,14 +269,14 @@
(let* (company-show-numbers
(company-candidates '("ArrayList"))
(company-candidates-length 1)
- (company-tooltip-maximum-width 9)
+ (company-tooltip-maximum-width 7)
(company-package-root default-directory)
(company-format-margin-function (lambda (candidate selected)
"X"))
(company-backend (lambda (c &rest _) (pcase c (`kind 'class)))))
(should (ert-equal-including-properties
(cadr (company--create-lines 0 999))
- #("XArrayList " 0 11
+ #("XArrayLi " 0 9
(face (company-tooltip-selection company-tooltip)
mouse-face (company-tooltip-mouse)))))))
