branch: master
commit ed14c673fb4ee8c3c150e1d74c21158f9d62caf9
Merge: c084cc1 3c11c30
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
Merge commit '3c11c30c9ab41d8a9c88560071c48fbcdcbcba5d' from company
---
packages/company/NEWS.md | 18 ++++++-
packages/company/company-capf.el | 82 ++++++++++++++++++--------------
packages/company/company-clang.el | 53 +++++++++++++++++----
packages/company/company-files.el | 2 +-
packages/company/company-gtags.el | 8 ++--
packages/company/company-template.el | 20 ++++++--
packages/company/company.el | 66 +++++++++++++++++--------
packages/company/test/frontends-tests.el | 8 ++++
8 files changed, 182 insertions(+), 75 deletions(-)
diff --git a/packages/company/NEWS.md b/packages/company/NEWS.md
index 8404398..7be2dd2 100644
--- a/packages/company/NEWS.md
+++ b/packages/company/NEWS.md
@@ -1,5 +1,21 @@
# History of user-visible changes
+## 2020-01-03 (0.9.11)
+
+* New value for option `company-show-numbers` to show numbers on the left.
+* `company-gtags` has some minor fixes.
+* Face definitions have moved to a separate group: `company-faces`.
+* `company-capf`'s `:exit-function` handling has been improved
+ ([#935](https://github.com/company-mode/company-mode/issues/935)).
+* New user option `company-clang-use-compile-flags-txt`
+ ([#933](https://github.com/company-mode/company-mode/issues/933)).
+* Support for completion style specific sorting (Emacs 27 feature).
+* Snippet/template field interaction is inhibited while completion is active
+ (where by default `TAB` calls `company-complete-common`, clashing with
snippet
+ map binding `TAB` to "jump to the next field"). Affects both
+ `company-template` and `yasnippet` (requires changes from 2019-04-21,
+ currently unreleased).
+
## 2019-04-15 (0.9.10)
* `company-clang`: better compatibility with Clang 8
@@ -295,7 +311,7 @@
## 2013-09-28 (0.6.12)
* Default value of `company-begin-commands` changed to `(self-insert-command)`.
-* Futher improvement in `org-indent-mode` compatibility.
+* Further improvement in `org-indent-mode` compatibility.
## 2013-08-18 (0.6.11)
diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el
index 64b3de9..cb30a80 100644
--- a/packages/company/company-capf.el
+++ b/packages/company/company-capf.el
@@ -1,6 +1,6 @@
;;; company-capf.el --- company-mode completion-at-point-functions backend -*-
lexical-binding: t -*-
-;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monn...@iro.umontreal.ca>
@@ -32,6 +32,7 @@
(require 'company)
(require 'cl-lib)
+;; Amortizes several calls to a c-a-p-f from the same position.
(defvar company--capf-cache nil)
;; FIXME: Provide a way to save this info once in Company itself
@@ -39,7 +40,11 @@
(defvar-local company-capf--current-completion-data nil
"Value last returned by `company-capf' when called with `candidates'.
For most properties/actions, this is just what we need: the exact values
-that accompanied the completion table that's currently is use.")
+that accompanied the completion table that's currently is use.
+
+`company-capf', however, could be called at some different positions during
+a completion session (most importantly, by `company-sort-by-occurrence'),
+so we can't just use the preceding variable instead.")
(defun company--capf-data ()
(let ((cache company--capf-cache))
@@ -83,6 +88,8 @@ that accompanied the completion table that's currently is
use.")
(defun company-capf--clear-current-data (_ignored)
(setq company-capf--current-completion-data nil))
+(defvar-local company-capf--sorted nil)
+
(defun company-capf (command &optional arg &rest _args)
"`company-mode' backend using `completion-at-point-functions'."
(interactive (list 'interactive))
@@ -98,35 +105,9 @@ that accompanied the completion table that's currently is
use.")
(length (cons prefix length))
(t prefix))))))
(`candidates
- (let ((res (company--capf-data)))
- (company-capf--save-current-data res)
- (when res
- (let* ((table (nth 3 res))
- (pred (plist-get (nthcdr 4 res) :predicate))
- (meta (completion-metadata
- (buffer-substring (nth 1 res) (nth 2 res))
- table pred))
- (sortfun (cdr (assq 'display-sort-function meta)))
- (candidates (completion-all-completions arg table pred (length
arg)))
- (last (last candidates))
- (base-size (and (numberp (cdr last)) (cdr last))))
- (when base-size
- (setcdr last nil))
- (when sortfun
- (setq candidates (funcall sortfun candidates)))
- (if (not (zerop (or base-size 0)))
- (let ((before (substring arg 0 base-size)))
- (mapcar (lambda (candidate)
- (concat before candidate))
- candidates))
- candidates)))))
+ (company-capf--candidates arg))
(`sorted
- (let ((res company-capf--current-completion-data))
- (when res
- (let ((meta (completion-metadata
- (buffer-substring (nth 1 res) (nth 2 res))
- (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
- (cdr (assq 'display-sort-function meta))))))
+ company-capf--sorted)
(`match
;; Ask the for the `:company-match' function. If that doesn't help,
;; fallback to sniffing for face changes to get a suitable value.
@@ -177,21 +158,50 @@ that accompanied the completion table that's currently is
use.")
(company--capf-post-completion arg))
))
+(defun company-capf--candidates (input)
+ (let ((res (company--capf-data)))
+ (company-capf--save-current-data res)
+ (when res
+ (let* ((table (nth 3 res))
+ (pred (plist-get (nthcdr 4 res) :predicate))
+ (meta (completion-metadata
+ (buffer-substring (nth 1 res) (nth 2 res))
+ table pred))
+ (candidates (completion-all-completions input table pred
+ (length input)
+ meta))
+ (sortfun (cdr (assq 'display-sort-function meta)))
+ (last (last candidates))
+ (base-size (and (numberp (cdr last)) (cdr last))))
+ (when base-size
+ (setcdr last nil))
+ (setq company-capf--sorted (functionp sortfun))
+ (when sortfun
+ (setq candidates (funcall sortfun candidates)))
+ (if (not (zerop (or base-size 0)))
+ (let ((before (substring input 0 base-size)))
+ (mapcar (lambda (candidate)
+ (concat before candidate))
+ candidates))
+ candidates)))))
+
(defun company--capf-post-completion (arg)
(let* ((res company-capf--current-completion-data)
(exit-function (plist-get (nthcdr 4 res) :exit-function))
- (table (nth 3 res))
- (pred (plist-get (nthcdr 4 res) :predicate)))
+ (table (nth 3 res)))
(if exit-function
- ;; Follow the example of `completion--done'.
+ ;; We can more or less know when the user is done with completion,
+ ;; so we do something different than `completion--done'.
(funcall exit-function arg
;; FIXME: Should probably use an additional heuristic:
;; completion-at-point doesn't know when the user picked a
;; particular candidate explicitly (it only checks whether
- ;; futher completions exist). Whereas company user can press
+ ;; further completions exist). Whereas company user can press
;; RET (or use implicit completion with company-tng).
- (if (eq (try-completion arg table pred) t)
- 'finished 'sole)))))
+ (if (= (car (completion-boundaries arg table nil ""))
+ (length arg))
+ 'sole
+ 'finished)))))
(provide 'company-capf)
diff --git a/packages/company/company-clang.el
b/packages/company/company-clang.el
index c0899b6..272dd8f 100644
--- a/packages/company/company-clang.el
+++ b/packages/company/company-clang.el
@@ -48,6 +48,16 @@ and `c-electric-colon', for automatic completion right after
\">\" and
\":\"."
:type 'boolean)
+(defcustom company-clang-use-compile-flags-txt nil
+ "When non-nil, use flags from compile_flags.txt if present.
+
+The lines from that files will be appended to `company-clang-arguments'.
+
+And if such file is found, Clang is called from the directory containing
+it. That allows the flags use relative file names within the project."
+ :type 'boolean
+ :safe 'booleanp)
+
(defcustom company-clang-arguments nil
"Additional arguments to pass to clang when completing.
Prefix files (-include ...) can be selected with `company-clang-set-prefix'
@@ -249,13 +259,36 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(append '("-fsyntax-only" "-Xclang" "-code-completion-macros")
(unless (company-clang--auto-save-p)
(list "-x" (company-clang--lang-option)))
- company-clang-arguments
+ (company-clang--arguments)
(when (stringp company-clang--prefix)
(list "-include" (expand-file-name company-clang--prefix)))
(list "-Xclang" (format "-code-completion-at=%s"
(company-clang--build-location pos)))
(list (if (company-clang--auto-save-p) buffer-file-name "-"))))
+(defun company-clang--arguments ()
+ (let ((fname "compile_flags.txt")
+ (args company-clang-arguments)
+ current-dir-rel)
+ (when company-clang-use-compile-flags-txt
+ (let ((dir (locate-dominating-file default-directory fname)))
+ (when dir
+ (setq current-dir-rel (file-relative-name default-directory dir))
+ (setq default-directory dir)
+ (with-temp-buffer
+ (insert-file-contents fname)
+ (setq args
+ (append
+ args
+ (split-string (buffer-substring-no-properties
+ (point-min) (point-max))
+ "[\n\r]+"
+ t
+ "[ \t]+"))))
+ (unless (equal current-dir-rel "./")
+ (push (format "-I%s" current-dir-rel) args)))))
+ args))
+
(defun company-clang--candidates (prefix callback)
(and (company-clang--auto-save-p)
(buffer-modified-p)
@@ -263,13 +296,14 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(when (null company-clang--prefix)
(company-clang-set-prefix (or (funcall company-clang-prefix-guesser)
'none)))
- (apply 'company-clang--start-process
- prefix
- callback
- (company-clang--build-complete-args
- (if (company-clang--check-version 4.0 9.0)
- (point)
- (- (point) (length prefix))))))
+ (let ((default-directory default-directory))
+ (apply 'company-clang--start-process
+ prefix
+ callback
+ (company-clang--build-complete-args
+ (if (company-clang--check-version 4.0 9.0)
+ (point)
+ (- (point) (length prefix)))))))
(defun company-clang--prefix ()
(if company-clang-begin-after-member-access
@@ -297,7 +331,8 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(with-temp-buffer
(call-process company-clang-executable nil t nil "--version")
(goto-char (point-min))
- (if (re-search-forward "\\(clang\\|Apple LLVM\\) version \\([0-9.]+\\)"
nil t)
+ (if (re-search-forward
+ "\\(clang\\|Apple LLVM\\|bcc32x\\|bcc64\\) version \\([0-9.]+\\)" nil
t)
(cons
(if (equal (match-string-no-properties 1) "Apple LLVM")
'apple
diff --git a/packages/company/company-files.el
b/packages/company/company-files.el
index c6102a1..91de1c6 100644
--- a/packages/company/company-files.el
+++ b/packages/company/company-files.el
@@ -70,7 +70,7 @@ The values should use the same format as
`completion-ignored-extensions'."
(begin (concat "\\(?:\\.\\{1,2\\}/\\|~/\\|" root "\\)")))
(list (concat "\"\\(" begin "[^\"\n]*\\)")
(concat "\'\\(" begin "[^\'\n]*\\)")
- (concat "\\(?:[ \t=]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
+ (concat "\\(?:[ \t=\[]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
(defun company-files--grab-existing-name ()
;; Grab the file name.
diff --git a/packages/company/company-gtags.el
b/packages/company/company-gtags.el
index 2a85f23..598ba60 100644
--- a/packages/company/company-gtags.el
+++ b/packages/company/company-gtags.el
@@ -1,6 +1,6 @@
;;; company-gtags.el --- company-mode completion backend for GNU Global
-;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2014-2020 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -65,7 +65,9 @@ completion."
(defun company-gtags--fetch-tags (prefix)
(with-temp-buffer
(let (tags)
- (when (= 0 (process-file company-gtags-executable nil
+ ;; For some reason Global v 6.6.3 is prone to returning exit status 1
+ ;; even on successful searches when '-T' is used.
+ (when (/= 3 (process-file company-gtags-executable nil
;; "-T" goes through all the tag files listed
in GTAGSLIBPATH
(list (current-buffer) nil) nil "-xGqT" (concat
"^" prefix)))
(goto-char (point-min))
@@ -87,7 +89,7 @@ completion."
(defun company-gtags--annotation (arg)
(let ((meta (get-text-property 0 'meta arg)))
- (when (string-match (concat arg "\\((.*)\\).*") meta)
+ (when (string-match (concat (regexp-quote arg) "\\((.*)\\).*") meta)
(match-string 1 meta))))
;;;###autoload
diff --git a/packages/company/company-template.el
b/packages/company/company-template.el
index 930e638..be4c41f 100644
--- a/packages/company/company-template.el
+++ b/packages/company/company-template.el
@@ -27,18 +27,26 @@
'((((background dark)) (:background "yellow" :foreground "black"))
(((background light)) (:background "orange" :foreground "black")))
"Face used for editable text in template fields."
- :group 'company)
+ :group 'company-faces)
+
+(defvar company-template-forward-field-item
+ '(menu-item "" company-template-forward-field
+ :filter company-template--keymap-filter))
(defvar company-template-nav-map
(let ((keymap (make-sparse-keymap)))
- (define-key keymap [tab] 'company-template-forward-field)
- (define-key keymap (kbd "TAB") 'company-template-forward-field)
+ (define-key keymap [tab] company-template-forward-field-item)
+ (define-key keymap (kbd "TAB") company-template-forward-field-item)
keymap))
+(defvar company-template-clear-field-item
+ '(menu-item "" company-template-clear-field
+ :filter company-template--keymap-filter))
+
(defvar company-template-field-map
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap company-template-nav-map)
- (define-key keymap (kbd "C-d") 'company-template-clear-field)
+ (define-key keymap (kbd "C-d") company-template-clear-field-item)
keymap))
(defvar-local company-template--buffer-templates nil)
@@ -78,6 +86,10 @@
(when (functionp after-clear-fn)
(funcall after-clear-fn))))))
+(defun company-template--keymap-filter (cmd)
+ (unless (run-hook-with-args-until-success 'yas-keymap-disable-hook)
+ cmd))
+
(defun company-template--after-clear-c-like-field ()
"Function that can be called after deleting a field of a c-like template.
For c-like templates it is set as `after-post-fn' property on fields in
diff --git a/packages/company/company.el b/packages/company/company.el
index 44177e7..f80fc1d 100644
--- a/packages/company/company.el
+++ b/packages/company/company.el
@@ -1,11 +1,11 @@
;;; company.el --- Modular text completion framework -*- lexical-binding: t
-*-
-;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgu...@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.9.10
+;; Version: 0.9.11
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3"))
@@ -79,11 +79,16 @@ attention to case differences."
string start-pos nil ignore-case)))))))
(defgroup company nil
- "Extensible inline text completion mechanism"
+ "Extensible inline text completion mechanism."
:group 'abbrev
:group 'convenience
:group 'matching)
+(defgroup company-faces nil
+ "Faces used by Company."
+ :group 'company
+ :group 'faces)
+
(defface company-tooltip
'((default :foreground "black")
(((class color) (min-colors 88) (background light))
@@ -180,6 +185,10 @@ attention to case differences."
(((background light)) (:background "firebrick4")))
"Face used for the common part of completions in the echo area.")
+;; Too lazy to re-add :group to all defcustoms down below.
+(setcdr (assoc load-file-name custom-current-group-alist)
+ 'company)
+
(defun company-frontends-set (variable value)
;; Uniquify.
(let ((value (delete-dups (copy-sequence value))))
@@ -415,7 +424,8 @@ non-prefix completion.
anything not offered as a candidate. Please don't use that value in normal
backends. The default value nil gives the user that choice with
`company-require-match'. Return value `never' overrides that option the
-other way around.
+other way around (using that value will indicate that the returned set of
+completions is often incomplete, so this behavior will not be useful).
`init': Called once for each buffer. The backend can check for external
programs and files and load any required libraries. Raising an error here
@@ -553,7 +563,7 @@ This can also be a function."
(defcustom company-auto-complete-chars '(?\ ?\) ?.)
"Determines which characters trigger auto-completion.
See `company-auto-complete'. If this is a string, each string character
-tiggers auto-completion. If it is a list of syntax description characters (see
+triggers auto-completion. If it is a list of syntax description characters
(see
`modify-syntax-entry'), all characters with that syntax auto-complete.
This can also be a function, which is called with the new input and should
@@ -631,13 +641,13 @@ commands in the `company-' namespace, abort completion."
(defcustom company-show-numbers nil
"If enabled, show quick-access numbers for the first ten candidates."
:type '(choice (const :tag "off" nil)
- (const :tag "on" t)))
+ (const :tag "left" 'left)
+ (const :tag "on" 't)))
(defcustom company-show-numbers-function #'company--show-numbers
- "Function called to get custom quick-access numbers for the first then
candidates.
+ "Function called to get quick-access numbers for the first ten candidates.
-If nil falls back to default function that generates 1...8, 9, 0. The function
get
-the number of candidates (from 1 to 10 means 1st to 10th candidate) and should
+The function receives the candidate number (starting from 1) and should
return a string prefixed with one space."
:type 'function)
@@ -774,9 +784,11 @@ keymap during active completions (`company-active-map'):
(progn
(add-hook 'pre-command-hook 'company-pre-command nil t)
(add-hook 'post-command-hook 'company-post-command nil t)
+ (add-hook 'yas-keymap-disable-hook 'company--active-p nil t)
(mapc 'company-init-backend company-backends))
(remove-hook 'pre-command-hook 'company-pre-command t)
(remove-hook 'post-command-hook 'company-post-command t)
+ (remove-hook 'yas-keymap-disable-hook 'company--active-p t)
(company-cancel)
(kill-local-variable 'company-point)))
@@ -820,7 +832,7 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(defvar company-emulation-alist '((t . nil)))
-(defsubst company-enable-overriding-keymap (keymap)
+(defun company-enable-overriding-keymap (keymap)
(company-uninstall-map)
(setq company-my-keymap keymap))
@@ -1616,8 +1628,11 @@ prefix match (same case) will be prioritized."
(cl-return c)))))
(defun company--perform ()
- (or (and company-candidates (company--continue))
- (and (company--should-complete) (company--begin-new)))
+ (cond
+ (company-candidates
+ (company--continue))
+ ((company--should-complete)
+ (company--begin-new)))
(if (not company-candidates)
(setq company-backend nil)
(setq company-point (point)
@@ -1669,6 +1684,9 @@ prefix match (same case) will be prioritized."
(defsubst company-keep (command)
(and (symbolp command) (get command 'company-keep)))
+(defun company--active-p ()
+ company-candidates)
+
(defun company-pre-command ()
(company--electric-restore-window-configuration)
(unless (company-keep this-command)
@@ -2266,7 +2284,8 @@ character, stripping the modifiers. That character must
be a digit."
(erase-buffer)
(when string
(save-excursion
- (insert string)))
+ (insert string)
+ (visual-line-mode)))
(current-buffer)))
(defvar company--electric-saved-window-configuration nil)
@@ -2535,6 +2554,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
right)))
(setq width (+ width margin (length right)))
+ ;; TODO: Use add-face-text-property in Emacs 24.4
(font-lock-append-text-property 0 width 'mouse-face
'company-tooltip-mouse
line)
@@ -2717,7 +2737,6 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(let ((str (concat (when nl " \n")
(mapconcat 'identity (nreverse new) "\n")
"\n")))
- (font-lock-append-text-property 0 (length str) 'face 'default str)
(when nl (put-text-property 0 1 'cursor t str))
str)))
@@ -2799,17 +2818,20 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
(let* ((item (pop items))
(str (car item))
(annotation (cdr item))
- (right (company-space-string company-tooltip-margin))
+ (margin (company-space-string company-tooltip-margin))
+ (left margin)
+ (right margin)
(width width))
(when (< numbered 10)
(cl-decf width 2)
(cl-incf numbered)
- (setq right (concat (funcall company-show-numbers-function
numbered) right)))
+ (setf (if (eq company-show-numbers 'left) left right)
+ (concat (funcall company-show-numbers-function numbered)
+ margin)))
(push (concat
(company-fill-propertize str annotation
width (equal i selection)
- (company-space-string
- company-tooltip-margin)
+ left
right)
(when scrollbar-bounds
(company--scrollbar i scrollbar-bounds)))
@@ -2917,8 +2939,9 @@ Returns a negative number if the tooltip should be
displayed above point."
(when company-pseudo-tooltip-overlay
(let* ((ov company-pseudo-tooltip-overlay)
(disp (overlay-get ov 'company-display)))
- ;; Beat outline's folding overlays, at least.
- (overlay-put ov 'priority 1)
+ ;; Beat outline's folding overlays.
+ ;; And Flymake (53). And Flycheck (110).
+ (overlay-put ov 'priority 111)
;; No (extra) prefix for the first line.
(overlay-put ov 'line-prefix "")
;; `display' is better
@@ -2928,6 +2951,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(overlay-put ov 'display disp)
(overlay-put ov 'after-string disp)
(overlay-put ov 'invisible t))
+ (overlay-put ov 'face 'default)
(overlay-put ov 'window (selected-window)))))
(defun company-pseudo-tooltip-guard ()
@@ -3032,7 +3056,7 @@ Delay is determined by `company-tooltip-idle-delay'."
pto
(char-before pos)
(eq pos (overlay-start pto)))))
- ;; Try to accomodate for the pseudo-tooltip overlay,
+ ;; Try to accommodate for the pseudo-tooltip overlay,
;; which may start at the same position if it's at eol.
(when ptf-workaround
(cl-decf beg)
diff --git a/packages/company/test/frontends-tests.el
b/packages/company/test/frontends-tests.el
index 7212c3f..f7f578e 100644
--- a/packages/company/test/frontends-tests.el
+++ b/packages/company/test/frontends-tests.el
@@ -139,6 +139,14 @@
(should (equal '(" x 1 " " y 2 " " z 3 ")
(company--create-lines 0 999)))))
+(ert-deftest company-create-lines-shows-numbers-on-the-left ()
+ (let ((company-show-numbers 'left)
+ (company-candidates '("x" "y" "z"))
+ (company-candidates-length 3)
+ (company-backend 'ignore))
+ (should (equal '(" 1 x " " 2 y " " 3 z ")
+ (company--create-lines 0 999)))))
+
(ert-deftest company-create-lines-truncates-annotations ()
(let* ((ww (company--window-width))
(data `(("1" . "(123)")
