branch: master
commit e65aa3fadd761e358055c3992c68096b65ac48d2
Merge: 32f6323 7cc0901
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
Merge commit '7cc0901489dff3d73ddc845ae060f938ecb85615' from company
---
packages/company/.travis.yml | 36 +++----
packages/company/NEWS.md | 23 ++++-
packages/company/company-capf.el | 5 +-
packages/company/company-clang.el | 94 ++++++++++--------
packages/company/company-dabbrev.el | 21 +++-
packages/company/company-elisp.el | 3 +-
packages/company/company-etags.el | 1 +
packages/company/company-keywords.el | 24 +++++
packages/company/company-nxml.el | 2 +-
packages/company/company-semantic.el | 5 +-
packages/company/company-tng.el | 163 +++++++++++++++++++++++++++++++
packages/company/company.el | 134 ++++++++++++++-----------
packages/company/test/async-tests.el | 28 +++---
packages/company/test/core-tests.el | 21 ++++
packages/company/test/frontends-tests.el | 8 ++
15 files changed, 431 insertions(+), 137 deletions(-)
diff --git a/packages/company/.travis.yml b/packages/company/.travis.yml
index 6993df8..b8eb249 100644
--- a/packages/company/.travis.yml
+++ b/packages/company/.travis.yml
@@ -1,24 +1,26 @@
-# https://github.com/rolandwalker/emacs-travis
+sudo: false
language: generic
-env:
- matrix:
- - EMACS=emacs24
- - EMACS=emacs-snapshot
+matrix:
+ include:
+ - env: EMACS=emacs24
+ addons:
+ apt:
+ sources: [ { sourceline: 'ppa:cassou/emacs' } ]
+ packages: [ emacs24, emacs24-el ]
+ - env: EMACS=emacs25
+ addons:
+ apt:
+ sources: [ { sourceline: 'ppa:kelleyk/emacs' } ]
+ packages: [ emacs25 ]
+ - env: EMACS=emacs-snapshot
+ addons:
+ apt:
+ sources: [ { sourceline: 'ppa:ubuntu-elisp/ppa' } ]
+ packages: [ emacs-snapshot ]
-install:
- - if [ "$EMACS" = "emacs24" ]; then
- sudo add-apt-repository -y ppa:cassou/emacs &&
- sudo apt-get update -qq &&
- sudo apt-get install -qq emacs24 emacs24-el;
- fi
- - if [ "$EMACS" = "emacs-snapshot" ]; then
- sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
- sudo apt-get update -qq &&
- sudo apt-get -qq -f install &&
- sudo apt-get install -qq emacs-snapshot;
- fi
+install: true
script:
make test-batch EMACS=${EMACS}
diff --git a/packages/company/NEWS.md b/packages/company/NEWS.md
index b219933..2db3dcf 100644
--- a/packages/company/NEWS.md
+++ b/packages/company/NEWS.md
@@ -1,5 +1,24 @@
# History of user-visible changes
+## 2018-02-18 (0.9.5)
+
+* The most common case of tooltip flickering with asynchronous backends (and
+ disabled built-in cache) is fixed
+ ([#510](https://github.com/company-mode/company-mode/issues/510),
+ [#654](https://github.com/company-mode/company-mode/issues/654)).
+* `company-keywords` added entries for `go-mode`, `swift-mode` and
+ `kotlin-mode`.
+* Native line numbers compatibility fixes.
+* `company-dabbrev` and `company-dabbrev-code` are more responsive when user
+ input is pending
+ ([#720](https://github.com/company-mode/company-mode/pull/720)).
+* New feature `company-tng`. It contains a frontend and some helper code.
+ The frontend triggers insertion of the candidate as soon as it's selected, so
+ you only need to press TAB. Add `(company-tng-configure-default)` to your
+ init script to give it a try
+ ([#706](https://github.com/company-mode/company-mode/issues/706)).
+* New user option `company-tooltip-maximum-width`.
+
## 2017-07-15 (0.9.4)
* Compatibility with native line numbers display in Emacs 26.
@@ -9,7 +28,7 @@
## 2017-03-29 (0.9.3)
-* New variable `company-echo-truncate-lines`.
+* New user option `company-echo-truncate-lines`.
* `company-auto-complete` improved compatibility with `electric-pair-mode`.
* Use of `overriding-terminal-local-map` does not disable completion.
* `company-clang` and `company-gtags` can work over Tramp.
@@ -26,7 +45,7 @@
* `company-indent-or-complete-common` skips trying to indent if
`indent-line-function` is `indent-relative` or `indent-relative-maybe`.
* Better visualization of search matches. New face
`company-tooltip-search-selection`.
-* New variable `company-files-exclusions`.
+* New user option `company-files-exclusions`.
* `company-next-page` and `company-previous-page` adhere to
`company-selection-wrap-around` docstring more closely and only wrap around
when the selection is at the start of the end of the list.
diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el
index 866fd62..06384c7 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-2016 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monn...@iro.umontreal.ca>
@@ -22,6 +22,9 @@
;;; Commentary:
;;
+;; The CAPF back-end provides a bridge to the standard
+;; completion-at-point-functions facility, and thus can support any major mode
+;; that defines a proper completion function, including emacs-lisp-mode.
;;; Code:
diff --git a/packages/company/company-clang.el
b/packages/company/company-clang.el
index 599491d..90a372e 100644
--- a/packages/company/company-clang.el
+++ b/packages/company/company-clang.el
@@ -1,6 +1,6 @@
;;; company-clang.el --- company-mode completion backend for Clang -*-
lexical-binding: t -*-
-;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2013-2017 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -45,7 +45,8 @@ symbol is preceded by \".\", \"->\" or \"::\", ignoring
If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
and `c-electric-colon', for automatic completion right after \">\" and
-\":\".")
+\":\"."
+ :type 'boolean)
(defcustom company-clang-arguments nil
"Additional arguments to pass to clang when completing.
@@ -200,34 +201,35 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(goto-char (point-min))))))
(defun company-clang--start-process (prefix callback &rest args)
- (let ((objc (derived-mode-p 'objc-mode))
- (buf (get-buffer-create "*clang-output*"))
- ;; Looks unnecessary in Emacs 25.1 and later.
- (process-adaptive-read-buffering nil))
- (if (get-buffer-process buf)
- (funcall callback nil)
- (with-current-buffer buf
- (erase-buffer)
- (setq buffer-undo-list t))
- (let* ((process-connection-type nil)
- (process (apply #'start-file-process "company-clang" buf
- company-clang-executable args)))
- (set-process-sentinel
- process
- (lambda (proc status)
- (unless (string-match-p "hangup" status)
- (funcall
- callback
- (let ((res (process-exit-status proc)))
- (with-current-buffer buf
- (unless (eq 0 res)
- (company-clang--handle-error res args))
- ;; Still try to get any useful input.
- (company-clang--parse-output prefix objc)))))))
- (unless (company-clang--auto-save-p)
- (send-region process (point-min) (point-max))
- (send-string process "\n")
- (process-send-eof process))))))
+ (let* ((objc (derived-mode-p 'objc-mode))
+ (buf (get-buffer-create "*clang-output*"))
+ ;; Looks unnecessary in Emacs 25.1 and later.
+ (process-adaptive-read-buffering nil)
+ (existing-process (get-buffer-process buf)))
+ (when existing-process
+ (kill-process existing-process))
+ (with-current-buffer buf
+ (erase-buffer)
+ (setq buffer-undo-list t))
+ (let* ((process-connection-type nil)
+ (process (apply #'start-file-process "company-clang" buf
+ company-clang-executable args)))
+ (set-process-sentinel
+ process
+ (lambda (proc status)
+ (unless (string-match-p "hangup\\|killed" status)
+ (funcall
+ callback
+ (let ((res (process-exit-status proc)))
+ (with-current-buffer buf
+ (unless (eq 0 res)
+ (company-clang--handle-error res args))
+ ;; Still try to get any useful input.
+ (company-clang--parse-output prefix objc)))))))
+ (unless (company-clang--auto-save-p)
+ (send-region process (point-min) (point-max))
+ (send-string process "\n")
+ (process-send-eof process)))))
(defsubst company-clang--build-location (pos)
(save-excursion
@@ -263,7 +265,10 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(apply 'company-clang--start-process
prefix
callback
- (company-clang--build-complete-args (- (point) (length prefix)))))
+ (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
@@ -277,18 +282,26 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(defvar company-clang--version nil)
(defun company-clang--auto-save-p ()
- (< company-clang--version 2.9))
+ (not
+ (company-clang--check-version 2.9 3.1)))
+
+(defun company-clang--check-version (min apple-min)
+ (pcase company-clang--version
+ (`(apple . ,ver) (>= ver apple-min))
+ (`(normal . ,ver) (>= ver min))
+ (_ (error "pcase-exhaustive is not in Emacs 24.3!"))))
(defsubst company-clang-version ()
"Return the version of `company-clang-executable'."
(with-temp-buffer
(call-process company-clang-executable nil t nil "--version")
(goto-char (point-min))
- (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t)
- (let ((ver (string-to-number (match-string-no-properties 1))))
- (if (> ver 100)
- (/ ver 100)
- ver))
+ (if (re-search-forward "\\(clang\\|Apple LLVM\\) version \\([0-9.]+\\)"
nil t)
+ (cons
+ (if (equal (match-string-no-properties 1) "Apple LLVM")
+ 'apple
+ 'normal)
+ (string-to-number (match-string-no-properties 2)))
0)))
(defun company-clang (command &optional arg &rest ignored)
@@ -310,8 +323,11 @@ passed via standard input."
(unless company-clang-executable
(error "Company found no clang executable"))
(setq company-clang--version (company-clang-version))
- (when (< company-clang--version company-clang-required-version)
- (error "Company requires clang version 1.1"))))
+ (unless (company-clang--check-version
+ company-clang-required-version
+ company-clang-required-version)
+ (error "Company requires clang version %s"
+ company-clang-required-version))))
(prefix (and (memq major-mode company-clang-modes)
buffer-file-name
company-clang-executable
diff --git a/packages/company/company-dabbrev.el
b/packages/company/company-dabbrev.el
index b1a9def..5d2f318 100644
--- a/packages/company/company-dabbrev.el
+++ b/packages/company/company-dabbrev.el
@@ -59,7 +59,11 @@ Or a function that returns non-nil for such buffers."
(defcustom company-dabbrev-ignore-case 'keep-prefix
"Non-nil to ignore case when collecting completion candidates.
When it's `keep-prefix', the text before point will remain unchanged after
-candidate is inserted, even some of its characters have different case.")
+candidate is inserted, even some of its characters have different case."
+ :type '(choice
+ (const :tag "Don't ignore case" nil)
+ (const :tag "Ignore case" t)
+ (const :tag "Keep case before point" keep-prefix)))
(defcustom company-dabbrev-downcase 'case-replace
"Whether to downcase the returned candidates.
@@ -69,7 +73,11 @@ The value of nil means keep them as-is.
Any other value means downcase.
If you set this value to nil, you may also want to set
-`company-dabbrev-ignore-case' to any value other than `keep-prefix'.")
+`company-dabbrev-ignore-case' to any value other than `keep-prefix'."
+ :type '(choice
+ (const :tag "Keep as-is" nil)
+ (const :tag "Downcase" t)
+ (const :tag "Use case-replace" case-replace)))
(defcustom company-dabbrev-minimum-length 4
"The minimum length for the completion candidate to be included.
@@ -110,7 +118,8 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
(goto-char (if pos (1- pos) (point-min)))
;; Search before pos.
(let ((tmp-end (point)))
- (company-dabbrev--time-limit-while (> tmp-end (point-min))
+ (company-dabbrev--time-limit-while (and (not (input-pending-p))
+ (> tmp-end (point-min)))
start limit 1
(ignore-errors
(forward-char -10000))
@@ -119,14 +128,16 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
;; Before, we used backward search, but it matches non-greedily,
and
;; that forced us to use the "beginning/end of word" anchors in
;; `company-dabbrev--make-regexp'. It's also about 2x slower.
- (while (re-search-forward regexp tmp-end t)
+ (while (and (not (input-pending-p))
+ (re-search-forward regexp tmp-end t))
(if (and ignore-comments (save-match-data
(company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
(maybe-collect-match))))
(setq tmp-end (point))))
(goto-char (or pos (point-min)))
;; Search after pos.
- (company-dabbrev--time-limit-while (re-search-forward regexp nil t)
+ (company-dabbrev--time-limit-while (and (not (input-pending-p))
+ (re-search-forward regexp nil t))
start limit 25
(if (and ignore-comments (save-match-data
(company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
diff --git a/packages/company/company-elisp.el
b/packages/company/company-elisp.el
index 40354d5..f95d41a 100644
--- a/packages/company/company-elisp.el
+++ b/packages/company/company-elisp.el
@@ -1,6 +1,6 @@
;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*-
lexical-binding: t -*-
-;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011-2013, 2017 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -22,6 +22,7 @@
;;; Commentary:
;;
+;; In newer versions of Emacs, company-capf is used instead.
;;; Code:
diff --git a/packages/company/company-etags.el
b/packages/company/company-etags.el
index ef53213..d0c27c9 100644
--- a/packages/company/company-etags.el
+++ b/packages/company/company-etags.el
@@ -76,6 +76,7 @@ Set it to t or to a list of major modes."
(defun company-etags--candidates (prefix)
(let ((tags-table-list (company-etags-buffer-table))
+ (tags-file-name tags-file-name)
(completion-ignore-case company-etags-ignore-case))
(and (or tags-file-name tags-table-list)
(fboundp 'tags-completion-table)
diff --git a/packages/company/company-keywords.el
b/packages/company/company-keywords.el
index bceb7f8..414c7b0 100644
--- a/packages/company/company-keywords.el
+++ b/packages/company/company-keywords.el
@@ -152,6 +152,13 @@
"break" "catch" "const" "continue" "delete" "do" "else" "export" "for"
"function" "if" "import" "in" "instanceOf" "label" "let" "new" "return"
"switch" "this" "throw" "try" "typeof" "var" "void" "while" "with"
"yield")
+ (kotlin-mode
+ "abstract" "annotation" "as" "break" "by" "catch" "class" "companion"
+ "const" "constructor" "continue" "data" "do" "else" "enum" "false" "final"
+ "finally" "for" "fun" "if" "import" "in" "init" "inner" "interface"
+ "internal" "is" "lateinit" "nested" "null" "object" "open" "out"
"override"
+ "package" "private" "protected" "public" "return" "super" "this" "throw"
+ "trait" "true" "try" "typealias" "val" "var" "when" "while")
(objc-mode
"@catch" "@class" "@encode" "@end" "@finally" "@implementation"
"@interface" "@private" "@protected" "@protocol" "@public"
@@ -212,6 +219,10 @@
"then" "true" "undef" "unless" "until" "when" "while" "yield")
;; From https://doc.rust-lang.org/grammar.html#keywords
;; but excluding unused reserved words:
https://www.reddit.com/r/rust/comments/34fq0k/is_there_a_good_list_of_rusts_keywords/cqucvnj
+ (go-mode
+ "break" "case" "chan" "const" "continue" "default" "defer" "else"
"fallthrough"
+ "for" "func" "go" "goto" "if" "import" "interface" "map" "package" "range"
+ "return" "select" "struct" "switch" "type" "var")
(rust-mode
"Self"
"as" "box" "break" "const" "continue" "crate" "else" "enum" "extern"
@@ -224,6 +235,19 @@
"new" "null" "object" "override" "package" "private" "protected"
"return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
"var" "while" "with" "yield")
+ (swift-mode
+ "Protocol" "Self" "Type" "and" "as" "assignment" "associatedtype"
+ "associativity" "available" "break" "case" "catch" "class" "column"
"continue"
+ "convenience" "default" "defer" "deinit" "didSet" "do" "dynamic"
"dynamicType"
+ "else" "elseif" "endif" "enum" "extension" "fallthrough" "false" "file"
+ "fileprivate" "final" "for" "func" "function" "get" "guard" "higherThan"
"if"
+ "import" "in" "indirect" "infix" "init" "inout" "internal" "is" "lazy"
"left"
+ "let" "line" "lowerThan" "mutating" "nil" "none" "nonmutating" "open"
+ "operator" "optional" "override" "postfix" "precedence" "precedencegroup"
+ "prefix" "private" "protocol" "public" "repeat" "required" "rethrows"
"return"
+ "right" "selector" "self" "set" "static" "struct" "subscript" "super"
"switch"
+ "throw" "throws" "true" "try" "typealias" "unowned" "var" "weak" "where"
+ "while" "willSet")
(julia-mode
"abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
"end" "eval" "export" "false" "finally" "for" "function" "global" "if"
diff --git a/packages/company/company-nxml.el b/packages/company/company-nxml.el
index 9c180e9..5afa00e 100644
--- a/packages/company/company-nxml.el
+++ b/packages/company/company-nxml.el
@@ -103,7 +103,7 @@
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(and (memq (char-after) '(?' ?\" ?\ ?\t ?\n)) ;; outside word
- (looking-back company-nxml-in-attribute-value-regexp)
+ (looking-back company-nxml-in-attribute-value-regexp nil)
(or (match-string-no-properties 4)
(match-string-no-properties 5)
""))))
diff --git a/packages/company/company-semantic.el
b/packages/company/company-semantic.el
index 8b13b72..2f6fe2a 100644
--- a/packages/company/company-semantic.el
+++ b/packages/company/company-semantic.el
@@ -56,7 +56,8 @@ symbol is preceded by \".\", \"->\" or \"::\", ignoring
If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
and `c-electric-colon', for automatic completion right after \">\" and
-\":\".")
+\":\"."
+ :type 'boolean)
(defcustom company-semantic-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
@@ -140,7 +141,7 @@ and `c-electric-colon', for automatic completion right
after \">\" and
(not (company-in-string-or-comment))
(or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
- (not (looking-back "->\\|\\." (- (point) 2))))
+ (not (looking-back "->\\|\\.\\|::" (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
diff --git a/packages/company/company-tng.el b/packages/company/company-tng.el
new file mode 100644
index 0000000..46592da
--- /dev/null
+++ b/packages/company/company-tng.el
@@ -0,0 +1,163 @@
+;;; company-tng.el --- company-mode configuration for single-button interaction
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Nikita Leshenko
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;;
+;; company-tng (Tab and Go) allows you to perform completion using just TAB.
+;; Pressing it will both select the next completion candidate in the list and
+;; insert it into the buffer (or make it look like it's inserted, in fact).
+;;
+;; It cycles the candidates like `yank-pop' or `dabbrev-expand' or Vim:
+;; Pressing TAB selects the first item in the completion menu and inserts it in
+;; the buffer. Pressing TAB again selects the second item and replaces the
+;; "inserted" item with the second one. This can continue as long as the user
+;; wishes to cycle through the menu. You can also press S-TAB to select the
+;; previous candidate, of course.
+;;
+;; The benefits are that you only have to use one shortcut key and there is no
+;; need to confirm the entry.
+;;
+;; Usage:
+;;
+;; To apply the default configuration for company-tng call
+;; `company-tng-configure-default' from your init script.
+;;
+;; You can also configure company-tng manually:
+;;
+;; Add `company-tng-frontend' to `company-frontends':
+;;
+;; (add-to-list 'company-frontends 'company-tng-frontend)
+;;
+;; We recommend to bind TAB to `company-select-next', S-TAB to
+;; `company-select-previous', and unbind RET and other now-unnecessary
+;; keys from `company-active-map':
+;;
+;; (define-key company-active-map (kbd "TAB") 'company-select-next)
+;; (define-key company-active-map (kbd "<backtab>") 'company-select-previous)
+;; (define-key company-active-map (kbd "RET") nil)
+;;
+;; Note that it's not necessary to rebind keys to use this frontend,
+;; you can use the arrow keys or M-n/M-p to select and insert
+;; candidates. You also need to decide which keys to unbind, depending
+;; on whether you want them to do the Company action or the default
+;; Emacs action (for example C-s or C-w).
+;;
+;; We recommend to disable `company-require-match' to allow free typing at any
+;; point.
+
+;;; Code:
+
+(require 'company)
+(require 'cl-lib)
+
+(defvar-local company-tng--overlay nil)
+
+;;;###autoload
+(defun company-tng-frontend (command)
+ "When the user changes the selection at least once, this
+frontend will display the candidate in the buffer as if it's
+already there and any key outside of `company-active-map' will
+confirm the selection and finish the completion."
+ (cl-case command
+ (show
+ (let ((ov (make-overlay (point) (point))))
+ (setq company-tng--overlay ov)
+ (overlay-put ov 'priority 2))
+ (advice-add 'company-select-next :before-until
'company-tng--allow-unselected)
+ (advice-add 'company-fill-propertize :filter-args
'company-tng--adjust-tooltip-highlight))
+ (update
+ (let ((ov company-tng--overlay)
+ (selected (nth company-selection company-candidates))
+ (prefix (length company-prefix)))
+ (move-overlay ov (- (point) prefix) (point))
+ (overlay-put ov
+ (if (= prefix 0) 'after-string 'display)
+ (and company-selection-changed selected))))
+ (hide
+ (when company-tng--overlay
+ (delete-overlay company-tng--overlay)
+ (kill-local-variable 'company-tng--overlay))
+ (advice-remove 'company-select-next 'company-tng--allow-unselected)
+ (advice-remove 'company-fill-propertize
'company-tng--adjust-tooltip-highlight))
+ (pre-command
+ (when (and company-selection-changed
+ (not (company--company-command-p (this-command-keys))))
+ (company--unread-this-command-keys)
+ (setq this-command 'company-complete-selection)))))
+
+;;;###autoload
+(defun company-tng-configure-default ()
+ "Applies the default configuration to enable company-tng."
+ (setq company-require-match nil)
+ (setq company-frontends '(company-tng-frontend
+ company-pseudo-tooltip-frontend
+ company-echo-metadata-frontend))
+ (let ((keymap company-active-map))
+ (define-key keymap [return] nil)
+ (define-key keymap (kbd "RET") nil)
+ (define-key keymap [tab] 'company-select-next)
+ (define-key keymap (kbd "TAB") 'company-select-next)
+ (define-key keymap [backtab] 'company-select-previous)
+ (define-key keymap (kbd "S-TAB") 'company-select-previous)))
+
+(defun company-tng--allow-unselected (&optional arg)
+ "Advice `company-select-next' to allow for an 'unselected'
+state. Unselected means that no user interaction took place on the
+completion candidates and it's marked by setting
+`company-selection-changed' to nil. This advice will call the underlying
+`company-select-next' unless we need to transition to or from an unselected
+state.
+
+Possible state transitions:
+- (arg > 0) unselected -> first candidate selected
+- (arg < 0) first candidate selected -> unselected
+- (arg < 0 wrap-round) unselected -> last candidate selected
+- (arg < 0 no wrap-round) unselected -> unselected
+
+There is no need to advice `company-select-previous' because it calls
+`company-select-next' internally."
+ (cond
+ ;; Selecting next
+ ((or (not arg) (> arg 0))
+ (unless company-selection-changed
+ (company-set-selection (1- (or arg 1)) 'force-update)
+ t))
+ ;; Selecting previous
+ ((< arg 0)
+ (when (and company-selection-changed
+ (< (+ company-selection arg) 0))
+ (company-set-selection 0)
+ (setq company-selection-changed nil)
+ (company-call-frontends 'update)
+ t)
+ )))
+
+(defun company-tng--adjust-tooltip-highlight (args)
+ "Prevent the tooltip from highlighting the current selection if it wasn't
+made explicitly (i.e. `company-selection-changed' is true)"
+ (unless company-selection-changed
+ ;; The 4th arg of `company-fill-propertize' is selected
+ (setf (nth 3 args) nil))
+ args)
+
+(provide 'company-tng)
+;;; company-tng.el ends here
diff --git a/packages/company/company.el b/packages/company/company.el
index 4551bb6..8ea1db0 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-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgu...@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.9.4
+;; Version: 0.9.5
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3"))
@@ -261,6 +261,12 @@ This doesn't include the margins and the scroll bar."
:type 'integer
:package-version '(company . "0.8.0"))
+(defcustom company-tooltip-maximum-width most-positive-fixnum
+ "The maximum width of the tooltip's inner area.
+This doesn't include the margins and the scroll bar."
+ :type 'integer
+ :package-version '(company . "0.9.5"))
+
(defcustom company-tooltip-margin 1
"Width of margin columns to show around the toolip."
:type 'integer)
@@ -809,6 +815,11 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(defun company-uninstall-map ()
(setf (cdar company-emulation-alist) nil))
+(defun company--company-command-p (keys)
+ "Checks if the keys are part of company's overriding keymap"
+ (or (equal [company-dummy-event] keys)
+ (lookup-key company-my-keymap keys)))
+
;; Hack:
;; Emacs calculates the active keymaps before reading the event. That means we
;; cannot change the keymap from a timer. So we send a bogus command.
@@ -822,6 +833,9 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(defun company-input-noop ()
(push 'company-dummy-event unread-command-events))
+;; To avoid warnings in Emacs < 26.
+(declare-function line-number-display-width "indent.c")
+
(defun company--posn-col-row (posn)
(let ((col (car (posn-col-row posn)))
;; `posn-col-row' doesn't work well with lines of different height.
@@ -832,11 +846,12 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(when (and header-line-format (version< emacs-version "24.3.93.3"))
;; http://debbugs.gnu.org/18384
(cl-decf row))
+ (when (bound-and-true-p display-line-numbers)
+ (cl-decf col (+ 2 (line-number-display-width))))
(cons (+ col (window-hscroll)) row)))
(defun company--col-row (&optional pos)
- (let (display-line-numbers)
- (company--posn-col-row (posn-at-point pos))))
+ (company--posn-col-row (posn-at-point pos)))
(defun company--row (&optional pos)
(cdr (company--col-row pos)))
@@ -911,6 +926,12 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(if (> (- (time-to-seconds) start) company-async-timeout)
(error "Company: backend %s async timeout with args %s"
backend args)
+ ;; XXX: Reusing the trick from company--fetch-candidates here
+ ;; doesn't work well: sit-for isn't a good fit when we want to
+ ;; ignore pending input (results in too many calls).
+ ;; FIXME: We should deal with this by standardizing on a kind of
+ ;; Future object that knows how to sync itself. In most cases (but
+ ;; not all), by calling accept-process-output, probably.
(sleep-for company-async-wait)))
res))))
@@ -958,7 +979,8 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(defun company--multi-backend-adapter-candidates (backends prefix separate)
(let ((pairs (cl-loop for backend in backends
when (equal (company--prefix-str
- (funcall backend 'prefix))
+ (let ((company-backend backend))
+ (company-call-backend 'prefix)))
prefix)
collect (cons (funcall backend 'candidates prefix)
(company--multi-candidates-mapper
@@ -1202,38 +1224,30 @@ can retrieve meta-data for them."
(defun company--fetch-candidates (prefix)
(let* ((non-essential (not (company-explicit-action-p)))
- (c (if company--manual-action
+ (c (if (or company-selection-changed
+ ;; FIXME: This is not ideal, but we have not managed to
deal
+ ;; with these situations in a better way yet.
+ (company-require-match-p))
(company-call-backend 'candidates prefix)
- (company-call-backend-raw 'candidates prefix)))
- res)
+ (company-call-backend-raw 'candidates prefix))))
(if (not (eq (car c) :async))
c
- (let ((buf (current-buffer))
- (win (selected-window))
- (tick (buffer-chars-modified-tick))
- (pt (point))
- (backend company-backend))
+ (let ((res 'none)
+ (inhibit-redisplay t))
(funcall
(cdr c)
(lambda (candidates)
- (if (not (and candidates (eq res 'done)))
- ;; There's no completions to display,
- ;; or the fetcher called us back right away.
- (setq res candidates)
- (setq company-backend backend
- company-candidates-cache
- (list (cons prefix
- (company--preprocess-candidates candidates))))
- (unwind-protect
- (company-idle-begin buf win tick pt)
- (unless company-candidates
- (setq company-backend nil
- company-candidates-cache nil)))))))
- ;; FIXME: Relying on the fact that the callers
- ;; will interpret nil as "do nothing" is shaky.
- ;; A throw-catch would be one possible improvement.
- (or res
- (progn (setq res 'done) nil)))))
+ (when (eq res 'none)
+ (push 'company-foo unread-command-events))
+ (setq res candidates)))
+ (while (and (eq res 'none)
+ (sit-for 0.5 t)))
+ (while (member (car unread-command-events)
+ '(company-foo (t . company-foo)))
+ (pop unread-command-events))
+ (prog1
+ (and (consp res) res)
+ (setq res 'exited))))))
(defun company--preprocess-candidates (candidates)
(cl-assert (cl-every #'stringp candidates))
@@ -1533,7 +1547,8 @@ prefix match (same case) will be prioritized."
(if (or (symbolp backend)
(functionp backend))
(when (company--maybe-init-backend backend)
- (funcall backend 'prefix))
+ (let ((company-backend backend))
+ (company-call-backend 'prefix)))
(company--multi-backend-adapter backend 'prefix)))
(when prefix
(when (company--good-prefix-p prefix)
@@ -1831,7 +1846,7 @@ each one wraps a part of the input string."
(interactive)
(company--search-assert-enabled)
(company-search-mode 0)
- (company--unread-last-input))
+ (company--unread-this-command-keys))
(defun company-search-delete-char ()
(interactive)
@@ -1975,7 +1990,7 @@ With ARG, move by that many elements."
(if (> company-candidates-length 1)
(company-select-next arg)
(company-abort)
- (company--unread-last-input)))
+ (company--unread-this-command-keys)))
(defun company-select-previous-or-abort (&optional arg)
"Select the previous candidate if more than one, else abort
@@ -1986,7 +2001,7 @@ With ARG, move by that many elements."
(if (> company-candidates-length 1)
(company-select-previous arg)
(company-abort)
- (company--unread-last-input)))
+ (company--unread-this-command-keys)))
(defun company-next-page ()
"Select the candidate one page further."
@@ -2054,7 +2069,7 @@ With ARG, move by that many elements."
0)))
t)
(company-abort)
- (company--unread-last-input)
+ (company--unread-this-command-keys)
nil)))
(defun company-complete-mouse (event)
@@ -2170,20 +2185,22 @@ character, stripping the modifiers. That character
must be a digit."
(make-string len ?\ )))
(defun company-safe-substring (str from &optional to)
- (if (> from (string-width str))
- ""
- (with-temp-buffer
- (insert str)
- (move-to-column from)
- (let ((beg (point)))
- (if to
- (progn
- (move-to-column to)
- (concat (buffer-substring beg (point))
- (let ((padding (- to (current-column))))
- (when (> padding 0)
- (company-space-string padding)))))
- (buffer-substring beg (point-max)))))))
+ (let ((bis buffer-invisibility-spec))
+ (if (> from (string-width str))
+ ""
+ (with-temp-buffer
+ (setq buffer-invisibility-spec bis)
+ (insert str)
+ (move-to-column from)
+ (let ((beg (point)))
+ (if to
+ (progn
+ (move-to-column to)
+ (concat (buffer-substring beg (point))
+ (let ((padding (- to (current-column))))
+ (when (> padding 0)
+ (company-space-string padding)))))
+ (buffer-substring beg (point-max))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2229,10 +2246,12 @@ character, stripping the modifiers. That character
must be a digit."
(< (- (window-height) row 2) company-tooltip-limit)
(recenter (- (window-height) row 2))))))
-(defun company--unread-last-input ()
- (when last-input-event
- (clear-this-command-keys t)
- (setq unread-command-events (list last-input-event))))
+(defun company--unread-this-command-keys ()
+ (when (> (length (this-command-keys)) 0)
+ (setq unread-command-events (nconc
+ (listify-key-sequence (this-command-keys))
+ unread-command-events))
+ (clear-this-command-keys t)))
(defun company-show-doc-buffer ()
"Temporarily show the documentation buffer for the selection."
@@ -2583,6 +2602,8 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
;; Account for the line continuation column.
(when (zerop (cadr (window-fringes)))
(cl-decf ww))
+ (when (bound-and-true-p display-line-numbers)
+ (cl-decf ww (+ 2 (line-number-display-width))))
(unless (or (display-graphic-p)
(version< "24.3.1" emacs-version))
;; Emacs 24.3 and earlier included margins
@@ -2690,10 +2711,10 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
(annotation (company-call-backend 'annotation value)))
(setq value (company--clean-string (company-reformat value)))
(when annotation
+ (setq annotation (company--clean-string annotation))
(when company-tooltip-align-annotations
;; `lisp-completion-at-point' adds a space.
- (setq annotation (comment-string-strip annotation t nil)))
- (setq annotation (company--clean-string annotation)))
+ (setq annotation (comment-string-strip annotation t nil))))
(push (cons value annotation) items)
(setq width (max (+ (length value)
(if (and annotation
company-tooltip-align-annotations)
@@ -2702,6 +2723,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
width))))
(setq width (min window-width
+ company-tooltip-maximum-width
(max company-tooltip-minimum-width
(if company-show-numbers
(+ 2 width)
diff --git a/packages/company/test/async-tests.el
b/packages/company/test/async-tests.el
index 48ebdfb..033b716 100644
--- a/packages/company/test/async-tests.el
+++ b/packages/company/test/async-tests.el
@@ -1,6 +1,6 @@
;;; async-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016, 2018 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@@ -65,27 +65,28 @@
(company-mode)
(let (company-frontends
company-transformers
- (company-backends (list 'company-async-backend)))
+ (company-backends (list 'company-async-backend))
+ unread-command-events
+ noninteractive
+ (start-time (current-time)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
- (should (null company-candidates))
- (sleep-for 0.1)
+ (should (< (time-to-seconds
+ (time-subtract (current-time) start-time))
+ 0.1))
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
-(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
+(ert-deftest company-idle-begin-with-async-aborts-on-user-input ()
(with-temp-buffer
(company-mode)
(let (company-frontends
- (company-backends (list 'company-async-backend)))
+ (company-backends (list 'company-async-backend))
+ noninteractive
+ (unread-command-events (list 'company-dummy-event)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
- (should (null company-candidates))
- (insert "a")
- (sleep-for 0.1)
- (should (null company-candidates))
- (should (null company-candidates-cache))
- (should (null company-backend)))))
+ (should (null company-candidates)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
@@ -100,7 +101,8 @@
(cons :async
(lambda (cb) (funcall cb c)))))
(`no-cache t)))))
- (company-minimum-prefix-length 0))
+ (company-minimum-prefix-length 0)
+ (unread-command-events (list 'company-dummy-event)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (equal '("abc" "def") company-candidates))
diff --git a/packages/company/test/core-tests.el
b/packages/company/test/core-tests.el
index 6c846d2..2e0c77f 100644
--- a/packages/company/test/core-tests.el
+++ b/packages/company/test/core-tests.el
@@ -544,3 +544,24 @@
(should (= (company--row) 0))
(setq header-line-format "aaaaaaa")
(should (= (company--row) 0)))))
+
+(ert-deftest company-column-with-line-numbers-display ()
+ :tags '(interactive)
+ (skip-unless (fboundp 'display-line-numbers-mode))
+ (with-temp-buffer
+ (display-line-numbers-mode)
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (should (= (company--column) 0)))))
+
+(ert-deftest company-row-and-column-with-line-numbers-display ()
+ :tags '(interactive)
+ (skip-unless (fboundp 'display-line-numbers-mode))
+ (with-temp-buffer
+ (display-line-numbers-mode)
+ (insert (make-string (+ (company--window-width)
(line-number-display-width)) ?a))
+ (insert ?\n)
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (should (= (company--column) 0))
+ (should (= (company--row) 2)))))
diff --git a/packages/company/test/frontends-tests.el
b/packages/company/test/frontends-tests.el
index 0f7c19e..7212c3f 100644
--- a/packages/company/test/frontends-tests.el
+++ b/packages/company/test/frontends-tests.el
@@ -367,6 +367,14 @@
(company-modify-line str "zz" 10)
"-*-foobar zz"))))
+(ert-deftest company-modify-line-with-invisible-prop ()
+ (let ((str "-*-foobar")
+ (buffer-invisibility-spec '((outline . t) t)))
+ (put-text-property 1 2 'invisible 'foo str)
+ (should (equal
+ (company-modify-line str "zz" 4)
+ "-*-fzzbar"))))
+
(ert-deftest company-scrollbar-bounds ()
(should (equal nil (company--scrollbar-bounds 0 3 3)))
(should (equal nil (company--scrollbar-bounds 0 4 3)))
