branch: externals/company
commit 123b604297b64c69aeec3018722c75e03d18c23a
Merge: 24aefbd 3644a59
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
Merge branch 'master' of https://github.com/company-mode/company-mode into
externals/company
---
.dir-locals.el | 3 +-
NEWS.md | 25 +++
README.md | 2 +-
company-clang.el | 21 ++-
company-cmake.el | 1 +
company-eclim.el | 186 ----------------------
company-gtags.el | 29 +++-
company-tng.el | 134 +++++++---------
company-xcode.el | 123 ---------------
company-yasnippet.el | 1 +
company.el | 404 +++++++++++++++++++++++++++++-------------------
test/core-tests.el | 145 +++++++++++++++--
test/frontends-tests.el | 2 +-
13 files changed, 515 insertions(+), 561 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 79d9a12..8e92085 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,5 @@
((nil . ((indent-tabs-mode . nil)
(fill-column . 80)
(sentence-end-double-space . t)
- (emacs-lisp-docstring-fill-column . 75))))
+ (emacs-lisp-docstring-fill-column . 75)
+ (project-vc-merge-submodules . nil))))
diff --git a/NEWS.md b/NEWS.md
index f1f1d05..38ef038 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,30 @@
# History of user-visible changes
+## Next
+
+* `company-gtags` on remote hosts is improved
+ ([#1037](https://github.com/company-mode/company-mode/pull/1037)).
+* New commands `company-select-first` and `company-select-last`.
+* `company-tng-mode` has been added to replace both
+ `company-tng-configure-default` and the manual method of enabling
+ `company-tng-frontend` (see also `company-tng-auto-configure`). Also,
+ `company-selection` can now have `nil` value, which means no selection.
+* `company-auto-complete` and `company-auto-complete-chars` have been renamed
to
+ `company-auto-commit` and `company-auto-commit-chars` respectively.
+* `company-clang` filters out duplicates
+ ([#841](https://github.com/company-mode/company-mode/issues/841)).
+* New user option `company-tooltip-width-grow-only`.
+* `company-xcode` has been removed. It has not been useful for years now.
+* `company-clang` has been moved to after `company-capf` in the default value
of
+ `company-backends`. So now if there is an active completion function in
+ `completion-at-point-functions`, it will have priority over
+ `company-clang`. Unless it's `tags-completion-at-point-function` (this one is
+ still skipped explicitly).
+* `company-eclim` has been removed. Eclim is generally not recommended for
Emacs
+ users these days, with
+ ([emacs-eclim](https://github.com/emacs-eclim/emacs-eclim/)) declared
obsolete
+ in favor of `lsp-java`. Though it used its own backend anyway.
+
## 2020-07-26 (0.9.13)
* `company-clang`: error handling is more permissive.
diff --git a/README.md b/README.md
index 1e0e5e6..b466d66 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
See the [homepage](http://company-mode.github.com/).
[](https://travis-ci.org/company-mode/company-mode)
-[](http://melpa.milkbox.net/#/company)
+[](https://melpa.org/#/company)
diff --git a/company-clang.el b/company-clang.el
index d7391b3..24e5977 100644
--- a/company-clang.el
+++ b/company-clang.el
@@ -136,6 +136,7 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(let ((pattern (format company-clang--completion-pattern
(regexp-quote prefix)))
(case-fold-search nil)
+ (results (make-hash-table :test 'equal :size (/ (point-max) 100)))
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
@@ -144,11 +145,21 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(when (string-match ":" match)
(setq match (substring match 0 (match-beginning 0)))))
(let ((meta (match-string-no-properties 2)))
- (when (and meta (not (string= match meta)))
- (put-text-property 0 1 'meta
- (company-clang--strip-formatting meta)
- match)))
- (push match lines)))
+ ;; Avoiding duplicates:
+ ;; https://github.com/company-mode/company-mode/issues/841
+ (cond
+ ;; Either meta != completion (not a macro)
+ ((not (equal match meta))
+ (puthash match meta results))
+ ;; Or it's the first time we see this completion
+ ((eq (gethash match results 'none) 'none)
+ (puthash match nil results))))))
+ (maphash
+ (lambda (match meta)
+ (when meta
+ (put-text-property 0 1 'meta (company-clang--strip-formatting meta)
match))
+ (push match lines))
+ results)
lines))
(defun company-clang--meta (candidate)
diff --git a/company-cmake.el b/company-cmake.el
index 2e69b6d..136c3e5 100644
--- a/company-cmake.el
+++ b/company-cmake.el
@@ -40,6 +40,7 @@
(defvar company-cmake-executable-arguments
'("--help-command-list"
"--help-module-list"
+ "--help-property-list"
"--help-variable-list")
"The arguments we pass to cmake, separately.
They affect which types of symbols we get completion candidates for.")
diff --git a/company-eclim.el b/company-eclim.el
deleted file mode 100644
index 4763e97..0000000
--- a/company-eclim.el
+++ /dev/null
@@ -1,186 +0,0 @@
-;;; company-eclim.el --- company-mode completion backend for Eclim
-
-;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
-
-;; Author: Nikolaj Schumacher
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Using `emacs-eclim' together with (or instead of) this backend is
-;; recommended, as it allows you to use other Eclim features.
-;;
-;; The alternative backend provided by `emacs-eclim' uses `yasnippet'
-;; instead of `company-template' to expand function calls, and it supports
-;; some languages other than Java.
-
-;;; Code:
-
-(require 'company)
-(require 'company-template)
-(require 'cl-lib)
-
-(defgroup company-eclim nil
- "Completion backend for Eclim."
- :group 'company)
-
-(defun company-eclim-executable-find ()
- (let (file)
- (cl-dolist (eclipse-root '("/Applications/eclipse" "/usr/lib/eclipse"
- "/usr/local/lib/eclipse"))
- (and (file-exists-p (setq file (expand-file-name "plugins"
eclipse-root)))
- (setq file (car (last (directory-files file t "^org.eclim_"))))
- (file-exists-p (setq file (expand-file-name "bin/eclim" file)))
- (cl-return file)))))
-
-(defcustom company-eclim-executable
- (or (bound-and-true-p eclim-executable)
- (executable-find "eclim")
- (company-eclim-executable-find))
- "Location of eclim executable."
- :type 'file)
-
-(defcustom company-eclim-auto-save t
- "Determines whether to save the buffer when retrieving completions.
-eclim can only complete correctly when the buffer has been saved."
- :type '(choice (const :tag "Off" nil)
- (const :tag "On" t)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar-local company-eclim--project-dir 'unknown)
-
-(defvar-local company-eclim--project-name nil)
-
-(declare-function json-read "json")
-(defvar json-array-type)
-
-(defun company-eclim--call-process (&rest args)
- (let ((coding-system-for-read 'utf-8)
- res)
- (require 'json)
- (with-temp-buffer
- (if (= 0 (setq res (apply 'call-process company-eclim-executable nil t
nil
- "-command" args)))
- (let ((json-array-type 'list))
- (goto-char (point-min))
- (unless (eobp)
- (json-read)))
- (message "Company-eclim command failed with error %d:\n%s" res
- (buffer-substring (point-min) (point-max)))
- nil))))
-
-(defun company-eclim--project-list ()
- (company-eclim--call-process "project_list"))
-
-(defun company-eclim--project-dir ()
- (if (eq company-eclim--project-dir 'unknown)
- (let ((dir (locate-dominating-file buffer-file-name ".project")))
- (when dir
- (setq company-eclim--project-dir
- (directory-file-name
- (expand-file-name dir)))))
- company-eclim--project-dir))
-
-(defun company-eclim--project-name ()
- (or company-eclim--project-name
- (let ((dir (company-eclim--project-dir)))
- (when dir
- (setq company-eclim--project-name
- (cl-loop for project in (company-eclim--project-list)
- when (equal (cdr (assoc 'path project)) dir)
- return (cdr (assoc 'name project))))))))
-
-(defun company-eclim--candidates (prefix)
- (interactive "d")
- (let ((project-file (file-relative-name buffer-file-name
- (company-eclim--project-dir)))
- completions)
- (when company-eclim-auto-save
- (when (buffer-modified-p)
- (basic-save-buffer))
- ;; FIXME: Sometimes this isn't finished when we complete.
- (company-eclim--call-process "java_src_update"
- "-p" (company-eclim--project-name)
- "-f" project-file))
- (dolist (item (cdr (assoc 'completions
- (company-eclim--call-process
- "java_complete" "-p"
(company-eclim--project-name)
- "-f" project-file
- "-o" (number-to-string
- (company-eclim--search-point prefix))
- "-e" "utf-8"
- "-l" "standard"))))
- (let* ((meta (cdr (assoc 'info item)))
- (completion meta))
- (when (string-match " ?[(:-]" completion)
- (setq completion (substring completion 0 (match-beginning 0))))
- (put-text-property 0 1 'meta meta completion)
- (push completion completions)))
- (let ((completion-ignore-case nil))
- (all-completions prefix completions))))
-
-(defun company-eclim--search-point (prefix)
- (if (or (cl-plusp (length prefix)) (eq (char-before) ?.))
- (1- (point))
- (point)))
-
-(defun company-eclim--meta (candidate)
- (get-text-property 0 'meta candidate))
-
-(defun company-eclim--annotation (candidate)
- (let ((meta (company-eclim--meta candidate)))
- (when (string-match "\\(([^-]*\\) -" meta)
- (substring meta (match-beginning 1) (match-end 1)))))
-
-(defun company-eclim--prefix ()
- (let ((prefix (company-grab-symbol)))
- (when prefix
- ;; Completion candidates for annotations don't include '@'.
- (when (eq ?@ (string-to-char prefix))
- (setq prefix (substring prefix 1)))
- prefix)))
-
-(defun company-eclim (command &optional arg &rest ignored)
- "`company-mode' completion backend for Eclim.
-Eclim provides access to Eclipse Java IDE features for other editors.
-
-Eclim version 1.7.13 or newer (?) is required.
-
-Completions only work correctly when the buffer has been saved.
-`company-eclim-auto-save' determines whether to do this automatically."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-eclim))
- (prefix (and (derived-mode-p 'java-mode 'jde-mode)
- buffer-file-name
- company-eclim-executable
- (company-eclim--project-name)
- (not (company-in-string-or-comment))
- (or (company-eclim--prefix) 'stop)))
- (candidates (company-eclim--candidates arg))
- (meta (company-eclim--meta arg))
- ;; because "" doesn't return everything
- (no-cache (equal arg ""))
- (annotation (company-eclim--annotation arg))
- (post-completion (let ((anno (company-eclim--annotation arg)))
- (when anno
- (insert anno)
- (company-template-c-like-templatify anno))))))
-
-(provide 'company-eclim)
-;;; company-eclim.el ends here
diff --git a/company-gtags.el b/company-gtags.el
index eb3c453..30b6f20 100644
--- a/company-gtags.el
+++ b/company-gtags.el
@@ -48,6 +48,7 @@
:package-version '(company . "0.8.1"))
(defvar-local company-gtags--tags-available-p 'unknown)
+(defvar-local company-gtags--executable 'unknown)
(defcustom company-gtags-modes '(prog-mode jde-mode)
"Modes that use `company-gtags'.
@@ -62,6 +63,32 @@ completion."
(locate-dominating-file buffer-file-name "GTAGS"))
company-gtags--tags-available-p))
+(defun company-gtags--executable ()
+ (cond
+ ((not (eq company-gtags--executable 'unknown)) ;; the value is already
cached
+ company-gtags--executable)
+ ((and (version<= "27" emacs-version) ;; can search remotely to set
+ (file-remote-p default-directory))
+
+ (with-connection-local-variables
+ (if (boundp 'company-gtags--executable-connection)
+ (setq-local company-gtags--executable ;; use if defined as
connection-local
+ company-gtags--executable-connection)
+
+ ;; Else search and set as connection local for next uses.
+ (setq-local company-gtags--executable (executable-find "global" t))
+ (let* ((host (file-remote-p default-directory 'host))
+ (symvars (intern (concat host "-vars")))) ;; profile name
+
+ (connection-local-set-profile-variables
+ symvars
+ `((company-gtags--executable-connection .
,company-gtags--executable)))
+
+ (connection-local-set-profiles `(:machine ,host) symvars))
+ company-gtags--executable)))
+ (t ;; use default value (searched locally)
+ company-gtags-executable)))
+
(defun company-gtags--fetch-tags (prefix)
(with-temp-buffer
(let (tags)
@@ -98,7 +125,7 @@ completion."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
- (prefix (and company-gtags-executable
+ (prefix (and (company-gtags--executable)
buffer-file-name
(apply #'derived-mode-p company-gtags-modes)
(not (company-in-string-or-comment))
diff --git a/company-tng.el b/company-tng.el
index bd325c7..3bfa298 100644
--- a/company-tng.el
+++ b/company-tng.el
@@ -38,14 +38,15 @@
;;
;; Usage:
;;
-;; To apply the default configuration for company-tng call
-;; `company-tng-configure-default' from your init script.
+;; Enable `company-tng-mode' with:
;;
-;; You can also configure company-tng manually:
+;; (add-hook 'after-init-hook 'company-tng-mode)
;;
-;; Add `company-tng-frontend' to `company-frontends':
+;; in your init script. It will set up the required frontend, as well as make a
+;; number of recommended configuration changes described below.
;;
-;; (add-to-list 'company-frontends 'company-tng-frontend)
+;; To avoid these changes, if you want to tweak everything yourself, customize
+;;`company-tng-auto-configure' to nil.
;;
;; We recommend to bind TAB to `company-select-next', S-TAB to
;; `company-select-previous', and unbind RET and other now-unnecessary
@@ -74,8 +75,8 @@
;; continues typing would be surprising and undesirable, since the candidate
was
;; already inserted into the buffer.
;;
-;; For this reason `company-tng-configure-default' disables arguments insertion
-;; for a number of popular backends. If the backend you are using is not among
+;; For this reason `company-tng-mode' by default disables arguments insertion
+;; for a number of popular backends. If the backend you are using is not among
;; them, you might have to configure it not to do that yourself.
;;
;; YASnippet and company-tng both use TAB, which causes conflicts. The
@@ -105,25 +106,22 @@ confirm the selection and finish the completion."
(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))
+ (overlay-put ov 'priority 2)))
(update
- (let ((ov company-tng--overlay)
- (selected (nth company-selection company-candidates))
- (prefix (length company-prefix)))
+ (let* ((ov company-tng--overlay)
+ (selected (and company-selection
+ (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))))
+ 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))
+ (kill-local-variable 'company-tng--overlay)))
(pre-command
- (when (and company-selection-changed
+ (when (and company-selection
(not (company--company-command-p (this-command-keys))))
(company--unread-this-command-keys)
(setq this-command 'company-complete-selection)))))
@@ -133,65 +131,51 @@ confirm the selection and finish the completion."
(defvar company-rtags-insert-arguments)
(defvar lsp-enable-snippet)
+(defgroup company-tng nil
+ "Company Tab and Go."
+ :group 'company)
+
+(defcustom company-tng-auto-configure t
+ "Automatically apply default configure when enable `company-tng-mode'."
+ :type 'boolean)
+
+;;;###autoload
+(define-obsolete-function-alias 'company-tng-configure-default
'company-tng-mode "0.9.14"
+ "Applies the default configuration to enable company-tng.")
+
+(declare-function eglot--snippet-expansion-fn "eglot")
+
;;;###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))
- (setq company-clang-insert-arguments nil
- company-semantic-insert-arguments nil
- company-rtags-insert-arguments nil
- lsp-enable-snippet nil)
- (advice-add #'eglot--snippet-expansion-fn :override #'ignore)
- (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."
+(define-minor-mode company-tng-mode
+ "This minor mode enables `company-tng-frontend'."
+ :init-value nil
+ :global t
(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)
+ (company-tng-mode
+ (setq company-frontends
+ (add-to-list 'company-frontends 'company-tng-frontend))
+ (when company-tng-auto-configure
+ (setq company-require-match nil)
+ (setq company-frontends '(company-tng-frontend
+ company-pseudo-tooltip-frontend
+ company-echo-metadata-frontend))
+ (setq company-clang-insert-arguments nil
+ company-semantic-insert-arguments nil
+ company-rtags-insert-arguments nil
+ lsp-enable-snippet nil)
+ (advice-add #'eglot--snippet-expansion-fn :override #'ignore)
+ (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)))
+ (setq company-selection-default nil))
+ (t
+ (setq company-frontends
+ (delete 'company-tng-frontend company-frontends))
+ (setq company-selection-default 0))))
(provide 'company-tng)
;;; company-tng.el ends here
diff --git a/company-xcode.el b/company-xcode.el
deleted file mode 100644
index ea89bcb..0000000
--- a/company-xcode.el
+++ /dev/null
@@ -1,123 +0,0 @@
-;;; company-xcode.el --- company-mode completion backend for Xcode projects
-
-;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
-
-;; Author: Nikolaj Schumacher
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-
-;;; Commentary:
-;;
-
-;;; Code:
-
-(require 'company)
-(require 'cl-lib)
-
-(defgroup company-xcode nil
- "Completion backend for Xcode projects."
- :group 'company)
-
-(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
- "Location of xcodeindex executable."
- :type 'file)
-
-(defvar company-xcode-tags nil)
-
-(defun company-xcode-reset ()
- "Reset the cached tags."
- (interactive)
- (setq company-xcode-tags nil))
-
-(defcustom company-xcode-types
- '("Class" "Constant" "Enum" "Macro" "Modeled Class" "Structure"
- "Type" "Union" "Function")
- "The types of symbols offered by `company-xcode'.
-No context-enabled completion is available. Types like methods will be
-offered regardless of whether the class supports them. The defaults should be
-valid in most contexts."
- :set (lambda (variable value)
- (set variable value)
- (company-xcode-reset))
- :type '(set (const "Category") (const "Class") (const "Class Method")
- (const "Class Variable") (const "Constant") (const "Enum")
- (const "Field") (const "Instance Method")
- (const "Instance Variable") (const "Macro")
- (const "Modeled Class") (const "Modeled Method")
- (const "Modeled Property") (const "Property") (const "Protocol")
- (const "Structure") (const "Type") (const "Union")
- (const "Variable") (const "Function")))
-
-(defvar-local company-xcode-project 'unknown)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun company-xcode-fetch (project-bundle)
- (setq project-bundle (directory-file-name project-bundle))
- (message "Retrieving dump from %s..." project-bundle)
- (with-temp-buffer
- (let ((default-directory (file-name-directory project-bundle)))
- (call-process company-xcode-xcodeindex-executable nil (current-buffer)
- nil "dump" "-project"
- (file-name-nondirectory project-bundle) "-quiet")
- (goto-char (point-min))
- (let ((regexp (concat "^\\([^\t\n]*\\)\t[^\t\n]*\t"
- (regexp-opt company-xcode-types)
- "\t[^\t\n]*\t[^\t\n]*"))
- candidates)
- (while (re-search-forward regexp nil t)
- (cl-pushnew (match-string 1) candidates :test #'equal))
- (message "Retrieving dump from %s...done" project-bundle)
- candidates))))
-
-(defun company-xcode-find-project ()
- (let ((dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- (expand-file-name default-directory)))
- (prev-dir nil)
- file)
- (while (not (or file (equal dir prev-dir)))
- (setq file (car (directory-files dir t ".xcodeproj\\'" t))
- prev-dir dir
- dir (file-name-directory (directory-file-name dir))))
- file))
-
-(defun company-xcode-tags ()
- (when (eq company-xcode-project 'unknown)
- (setq company-xcode-project (company-xcode-find-project)))
- (when company-xcode-project
- (cdr (or (assoc company-xcode-project company-xcode-tags)
- (car (push (cons company-xcode-project
- (company-xcode-fetch company-xcode-project))
- company-xcode-tags))))))
-;;;###autoload
-(defun company-xcode (command &optional arg &rest ignored)
- "`company-mode' completion backend for Xcode projects."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-xcode))
- (prefix (and company-xcode-xcodeindex-executable
- (company-xcode-tags)
- (not (company-in-string-or-comment))
- (or (company-grab-symbol) 'stop)))
- (candidates (let ((completion-ignore-case nil))
- (company-xcode-tags)
- (all-completions arg (company-xcode-tags))))))
-
-
-(provide 'company-xcode)
-;;; company-xcode.el ends here
diff --git a/company-yasnippet.el b/company-yasnippet.el
index 197ae78..dfc959c 100644
--- a/company-yasnippet.el
+++ b/company-yasnippet.el
@@ -34,6 +34,7 @@
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
(declare-function yas--warning "yasnippet")
+(declare-function yas-minor-mode "yasnippet")
(defvar company-yasnippet-annotation-fn
(lambda (name)
diff --git a/company.el b/company.el
index b96983b..34721b1 100644
--- a/company.el
+++ b/company.el
@@ -280,6 +280,11 @@ This doesn't include the margins and the scroll bar."
:type 'integer
:package-version '(company . "0.9.5"))
+(defcustom company-tooltip-width-grow-only nil
+ "When non-nil, the tooltip width is not allowed to decrease."
+ :type 'boolean
+ :package-version '(company . "0.9.14"))
+
(defcustom company-tooltip-margin 1
"Width of margin columns to show around the toolip."
:type 'integer)
@@ -307,21 +312,19 @@ This doesn't include the margins and the scroll bar."
(company-capf . "completion-at-point-functions")
(company-clang . "Clang")
(company-cmake . "CMake")
- (company-css . "CSS")
+ (company-css . "CSS (obsolete backend)")
(company-dabbrev . "dabbrev for plain text")
(company-dabbrev-code . "dabbrev for code")
- (company-eclim . "Eclim (an Eclipse interface)")
- (company-elisp . "Emacs Lisp")
+ (company-elisp . "Emacs Lisp (obsolete backend)")
(company-etags . "etags")
(company-files . "Files")
(company-gtags . "GNU Global")
(company-ispell . "Ispell")
(company-keywords . "Programming language keywords")
- (company-nxml . "nxml")
+ (company-nxml . "nxml (obsolete backend)")
(company-oddmuse . "Oddmuse")
(company-semantic . "Semantic")
- (company-tempo . "Tempo templates")
- (company-xcode . "Xcode")))
+ (company-tempo . "Tempo templates")))
(put 'company-safe-backends 'risky-local-variable t)
(defun company-safe-backends-p (backends)
@@ -339,9 +342,10 @@ This doesn't include the margins and the scroll bar."
(list 'company-nxml))
,@(unless (version<= "26" emacs-version)
(list 'company-css))
- company-eclim company-semantic company-clang
- company-xcode company-cmake
+ company-semantic
+ company-cmake
company-capf
+ company-clang
company-files
(company-dabbrev-code company-gtags company-etags
company-keywords)
@@ -544,34 +548,45 @@ prefix it was started from."
This can be a function do determine if a match is required.
This can be overridden by the backend, if it returns t or `never' to
-`require-match'. `company-auto-complete' also takes precedence over this."
+`require-match'. `company-auto-commit' also takes precedence over this."
:type '(choice (const :tag "Off" nil)
(function :tag "Predicate function")
(const :tag "On, if user interaction took place"
'company-explicit-action-p)
(const :tag "On" t)))
-(defcustom company-auto-complete nil
- "Determines when to auto-complete.
-If this is enabled, all characters from `company-auto-complete-chars'
+(define-obsolete-variable-alias
+ 'company-auto-complete
+ 'company-auto-commit
+ "0.9.14")
+
+(defcustom company-auto-commit nil
+ "Determines whether to auto-commit.
+If this is enabled, all characters from `company-auto-commit-chars'
trigger insertion of the selected completion candidate.
This can also be a function."
:type '(choice (const :tag "Off" nil)
(function :tag "Predicate function")
(const :tag "On, if user interaction took place"
'company-explicit-action-p)
- (const :tag "On" t)))
+ (const :tag "On" t))
+ :package-version '(company . "0.9.14"))
-(defcustom company-auto-complete-chars '(?\ ?\) ?.)
- "Determines which characters trigger auto-completion.
-See `company-auto-complete'. If this is a string, each string character
-triggers auto-completion. If it is a list of syntax description characters
(see
-`modify-syntax-entry'), all characters with that syntax auto-complete.
+(define-obsolete-variable-alias
+ 'company-auto-complete-chars
+ 'company-auto-commit-chars
+ "0.9.14")
+
+(defcustom company-auto-commit-chars '(?\ ?\) ?.)
+ "Determines which characters trigger auto-commit.
+See `company-auto-commit'. If this is a string, each character in it
+triggers auto-commit. If it is a list of syntax description characters (see
+`modify-syntax-entry'), characters with any of those syntaxes do that.
This can also be a function, which is called with the new input and should
-return non-nil if company should auto-complete.
+return non-nil if company should auto-commit.
-A character that is part of a valid candidate never triggers auto-completion."
+A character that is part of a valid completion never triggers auto-commit."
:type '(choice (string :tag "Characters")
(set :tag "Syntax"
(const :tag "Whitespace" ?\ )
@@ -588,7 +603,8 @@ A character that is part of a valid candidate never
triggers auto-completion."
(const :tag "Character-quote." ?/)
(const :tag "Generic string fence." ?|)
(const :tag "Generic comment fence." ?!))
- (function :tag "Predicate function")))
+ (function :tag "Predicate function"))
+ :package-version '(company . "0.9.14"))
(defcustom company-idle-delay .5
"The idle delay in seconds until completion starts automatically.
@@ -741,9 +757,10 @@ asynchronous call into synchronous.")
(company-candidates
(:eval
(if (consp company-backend)
- (company--group-lighter (nth company-selection
-
company-candidates)
- company-lighter-base)
+ (when company-selection
+ (company--group-lighter (nth
company-selection
+
company-candidates)
+
company-lighter-base))
(symbol-name company-backend)))
company-lighter-base))
"Mode line lighter for Company.
@@ -1092,7 +1109,9 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(defvar-local company-common nil)
-(defvar-local company-selection 0)
+(defvar company-selection-default 0
+ "The default value for `company-selection'.")
+(defvar-local company-selection company-selection-default)
(defvar-local company-selection-changed nil)
@@ -1101,10 +1120,6 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a
cons."
(defvar-local company--manual-prefix nil)
-(defvar company--auto-completion nil
- "Non-nil when current candidate is being inserted automatically.
-Controlled by `company-auto-complete'.")
-
(defvar-local company--point-max nil)
(defvar-local company-point nil)
@@ -1180,10 +1195,21 @@ can retrieve meta-data for them."
frontend (error-message-string err) command)))))
(defun company-set-selection (selection &optional force-update)
- (setq selection
- (if company-selection-wrap-around
- (mod selection company-candidates-length)
- (max 0 (min (1- company-candidates-length) selection))))
+ "Set SELECTION for company candidates.
+This will update `company-selection' and related variable.
+Only update when the current selection is changed, but optionally always
+update if FORCE-UPDATE."
+ (when selection
+ (let* ((offset (if company-selection-default 0 1))
+ (company-candidates-length
+ (+ company-candidates-length offset)))
+ (setq selection (+ selection offset))
+ (setq selection
+ (if company-selection-wrap-around
+ (mod selection company-candidates-length)
+ (max 0 (min (1- company-candidates-length) selection))))
+ (setq selection (unless (< selection offset)
+ (- selection offset)))))
(when (or force-update (not (equal selection company-selection)))
(setq company-selection selection
company-selection-changed t)
@@ -1202,10 +1228,11 @@ can retrieve meta-data for them."
(setq company-candidates-length (length candidates))
(if company-selection-changed
;; Try to restore the selection
- (let ((selected (nth company-selection company-candidates)))
- (setq company-selection 0
- company-candidates candidates)
+ (let ((selected (and company-selection
+ (nth company-selection company-candidates))))
+ (setq company-candidates candidates)
(when selected
+ (setq company-selection 0)
(catch 'found
(while candidates
(let ((candidate (pop candidates)))
@@ -1214,9 +1241,9 @@ can retrieve meta-data for them."
(company-call-backend 'annotation selected)))
(throw 'found t)))
(cl-incf company-selection))
- (setq company-selection 0
+ (setq company-selection company-selection-default
company-selection-changed nil))))
- (setq company-selection 0
+ (setq company-selection company-selection-default
company-candidates candidates))
;; Calculate common.
(let ((completion-ignore-case (company-call-backend 'ignore-case)))
@@ -1505,18 +1532,18 @@ prefix match (same case) will be prioritized."
(funcall company-require-match)
(eq company-require-match t))))))
-(defun company-auto-complete-p (input)
- "Return non-nil if INPUT should trigger auto-completion."
- (and (if (functionp company-auto-complete)
- (funcall company-auto-complete)
- company-auto-complete)
- (if (functionp company-auto-complete-chars)
- (funcall company-auto-complete-chars input)
- (if (consp company-auto-complete-chars)
+(defun company-auto-commit-p (input)
+ "Return non-nil if INPUT should trigger auto-commit."
+ (and (if (functionp company-auto-commit)
+ (funcall company-auto-commit)
+ company-auto-commit)
+ (if (functionp company-auto-commit-chars)
+ (funcall company-auto-commit-chars input)
+ (if (consp company-auto-commit-chars)
(memq (char-syntax (string-to-char input))
- company-auto-complete-chars)
+ company-auto-commit-chars)
(string-match (regexp-quote (substring input 0 1))
- company-auto-complete-chars)))))
+ company-auto-commit-chars)))))
(defun company--incremental-p ()
(and (> (point) company-point)
@@ -1580,12 +1607,11 @@ prefix match (same case) will be prioritized."
(company-update-candidates c)
c)
((and (characterp last-command-event)
- (company-auto-complete-p (string last-command-event)))
- ;; auto-complete
+ (company-auto-commit-p (string last-command-event)))
+ ;; auto-commit
(save-excursion
(goto-char company-point)
- (let ((company--auto-completion t))
- (company-complete-selection))
+ (company-complete-selection)
nil))
((not (company--incremental-p))
(company-cancel))
@@ -1655,7 +1681,7 @@ prefix match (same case) will be prioritized."
company-candidates-cache nil
company-candidates-predicate nil
company-common nil
- company-selection 0
+ company-selection company-selection-default
company-selection-changed nil
company--manual-action nil
company--manual-prefix nil
@@ -1819,6 +1845,7 @@ each one wraps a part of the input string."
(defun company--permutations (lst)
(if (not lst)
'(nil)
+ ;; FIXME: Replace with `mapcan' in Emacs 26.
(cl-mapcan
(lambda (e)
(mapcar (lambda (perm) (cons e perm))
@@ -1859,11 +1886,12 @@ each one wraps a part of the input string."
(company-update-candidates cc)))
(defun company--search-update-string (new)
- (let* ((pos (company--search new (nthcdr company-selection
company-candidates))))
+ (let* ((selection (or company-selection 0))
+ (pos (company--search new (nthcdr selection company-candidates))))
(if (null pos)
(ding)
(setq company-search-string new)
- (company-set-selection (+ company-selection pos) t))))
+ (company-set-selection (+ selection pos) t))))
(defun company--search-assert-input ()
(company--search-assert-enabled)
@@ -1874,24 +1902,25 @@ each one wraps a part of the input string."
"Repeat the incremental search in completion candidates forward."
(interactive)
(company--search-assert-input)
- (let ((pos (company--search company-search-string
- (cdr (nthcdr company-selection
- company-candidates)))))
+ (let* ((selection (or company-selection 0))
+ (pos (company--search company-search-string
+ (cdr (nthcdr selection company-candidates)))))
(if (null pos)
(ding)
- (company-set-selection (+ company-selection pos 1) t))))
+ (company-set-selection (+ selection pos 1) t))))
(defun company-search-repeat-backward ()
"Repeat the incremental search in completion candidates backwards."
(interactive)
(company--search-assert-input)
- (let ((pos (company--search company-search-string
+ (let* ((selection (or company-selection 0))
+ (pos (company--search company-search-string
(nthcdr (- company-candidates-length
- company-selection)
+ selection)
(reverse company-candidates)))))
(if (null pos)
(ding)
- (company-set-selection (- company-selection pos 1) t))))
+ (company-set-selection (- selection pos 1) t))))
(defun company-search-toggle-filtering ()
"Toggle `company-search-filtering'."
@@ -2016,14 +2045,6 @@ uses the search string to filter the completion
candidates."
(interactive)
(company-search-mode 1))
-(defvar company-filter-map
- (let ((keymap (make-keymap)))
- (define-key keymap [remap company-search-printing-char]
- 'company-filter-printing-char)
- (set-keymap-parent keymap company-search-map)
- keymap)
- "Keymap used for incrementally searching the completion candidates.")
-
(defun company-filter-candidates ()
"Start filtering the completion candidates incrementally.
This works the same way as `company-search-candidates' immediately
@@ -2037,10 +2058,16 @@ followed by `company-search-toggle-filtering'."
(defun company-select-next (&optional arg)
"Select the next candidate in the list.
-With ARG, move by that many elements."
+With ARG, move by that many elements.
+When `company-selection-default' is nil, add a special pseudo candidates
+meant for no selection."
(interactive "p")
(when (company-manual-begin)
- (company-set-selection (+ (or arg 1) company-selection))))
+ (let ((selection (+ (or arg 1)
+ (or company-selection
+ company-selection-default
+ -1))))
+ (company-set-selection selection))))
(defun company-select-previous (&optional arg)
"Select the previous candidate in the list.
@@ -2071,6 +2098,16 @@ With ARG, move by that many elements."
(company-abort)
(company--unread-this-command-keys)))
+(defun company-select-first ()
+ "Select the first completion candidate."
+ (interactive)
+ (company-set-selection 0))
+
+(defun company-select-last ()
+ "Select the last completion candidate."
+ (interactive)
+ (company-set-selection (1- company-candidates-length)))
+
(defun company-next-page ()
"Select the candidate one page further."
(interactive)
@@ -2149,7 +2186,7 @@ With ARG, move by that many elements."
(defun company-complete-selection ()
"Insert the selected candidate."
(interactive)
- (when (company-manual-begin)
+ (when (and (company-manual-begin) company-selection)
(let ((result (nth company-selection company-candidates)))
(company-finish result))))
@@ -2277,7 +2314,7 @@ character, stripping the modifiers. That character must
be a digit."
(defvar-local company-last-metadata nil)
(defun company-fetch-metadata ()
- (let ((selected (nth company-selection company-candidates)))
+ (let ((selected (nth (or company-selection 0) company-candidates)))
(unless (eq selected (car company-last-metadata))
(setq company-last-metadata
(cons selected (company-call-backend 'meta selected))))
@@ -2328,9 +2365,10 @@ character, stripping the modifiers. That character must
be a digit."
(defun company-show-doc-buffer ()
"Temporarily show the documentation buffer for the selection."
(interactive)
- (let (other-window-scroll-buffer)
+ (let ((other-window-scroll-buffer)
+ (selection (or company-selection 0)))
(company--electric-do
- (let* ((selected (nth company-selection company-candidates))
+ (let* ((selected (nth selection company-candidates))
(doc-buffer (or (company-call-backend 'doc-buffer selected)
(user-error "No documentation available")))
start)
@@ -2438,6 +2476,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
thereis (let ((company-backend b))
(setq backend b)
(company-call-backend 'prefix))))
+ (c-a-p-f completion-at-point-functions)
cc annotations)
(when (or (stringp prefix) (consp prefix))
(let ((company-backend backend))
@@ -2464,7 +2503,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(memq 'company-capf backend)
(eq backend 'company-capf))
(insert "Value of c-a-p-f: "
- (pp-to-string completion-at-point-functions)))
+ (pp-to-string c-a-p-f)))
(insert "Major mode: " mode)
(insert "\n")
(insert "Prefix: " (pp-to-string prefix))
@@ -2486,6 +2525,8 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(defvar-local company-tooltip-offset 0)
+(defvar-local company--tooltip-current-width 0)
+
(defun company-tooltip--lines-update-offset (selection num-lines limit)
(cl-decf limit 2)
(setq company-tooltip-offset
@@ -2637,7 +2678,10 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
((match-beginning 1)
;; FIXME: Better char for 'non-printable'?
;; We shouldn't get any of these, but sometimes we might.
- "\u2017")
+ ;; The official "replacement character" is not supported by some fonts.
+ ;;"\ufffd"
+ "?"
+ )
((match-beginning 2)
;; Zero-width non-breakable space.
"")
@@ -2712,6 +2756,27 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(cl-decf ww (1- (length (aref buffer-display-table ?\n)))))
ww))
+(defun company--face-attribute (face attr)
+ ;; Like `face-attribute', but accounts for faces that have been remapped to
+ ;; another face, a list of faces, or a face spec.
+ (cond ((null face) nil)
+ ((symbolp face)
+ (let ((remap (cdr (assq face face-remapping-alist))))
+ (if remap
+ (company--face-attribute
+ ;; Faces can be remapped to their unremapped selves, but that
+ ;; would cause us infinite recursion.
+ (if (listp remap) (remq face remap) remap)
+ attr)
+ (face-attribute face attr nil t))))
+ ((keywordp (car-safe face))
+ (or (plist-get face attr)
+ (company--face-attribute (plist-get face :inherit) attr)))
+ ((listp face)
+ (cl-find-if #'stringp
+ (mapcar (lambda (f) (company--face-attribute f attr))
+ face)))))
+
(defun company--replacement-string (lines old column nl &optional align-top)
(cl-decf column company-tooltip-margin)
@@ -2744,9 +2809,21 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(company--offset-line (pop lines) offset))
new))
- (let ((str (concat (when nl " \n")
- (mapconcat 'identity (nreverse new) "\n")
- "\n")))
+ ;; XXX: Also see branch 'more-precise-extend'.
+ (let* ((nl-face (list
+ :extend t
+ :inverse-video nil
+ :background (or (company--face-attribute 'default
:background)
+ (face-attribute 'default :background nil
t))))
+ (str (apply #'concat
+ (when nl " \n")
+ (cl-mapcan
+ ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=42552#23
+ (lambda (line) (list line (propertize "\n" 'face
nl-face)))
+ (nreverse new)))))
+ ;; Use add-face-text-property in Emacs 24.4
+ ;; https://debbugs.gnu.org/38563
+ (font-lock-append-text-property 0 (length str) 'face 'default str)
(when nl (put-text-property 0 1 'cursor t str))
str)))
@@ -2770,23 +2847,26 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
(when (< len (+ company-tooltip-offset limit))
(setq company-tooltip-offset 0))
- ;; Scroll to offset.
- (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))
+ (let ((selection (or selection 0)))
+ ;; Scroll to offset.
+ (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)))))))
+
+ (when selection
+ (cl-decf selection company-tooltip-offset))
- (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))))))
-
- (cl-decf selection company-tooltip-offset)
(setq width (max (length previous) (length remainder))
lines (nthcdr company-tooltip-offset company-candidates)
len (min limit len)
@@ -2803,6 +2883,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(setq annotation (company--clean-string annotation))
(when company-tooltip-align-annotations
;; `lisp-completion-at-point' adds a space.
+ ;; FIXME: Use `string-trim' in Emacs 24.4
(setq annotation (comment-string-strip annotation t nil))))
(push (cons value annotation) items)
(setq width (max (+ (length value)
@@ -2818,6 +2899,10 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(+ 2 width)
width))))
+ (when company-tooltip-width-grow-only
+ (setq width (max company--tooltip-current-width width))
+ (setq company--tooltip-current-width width))
+
(let ((items (nreverse items))
(numbered (if company-show-numbers 0 99999))
new)
@@ -2955,14 +3040,12 @@ Returns a negative number if the tooltip should be
displayed above point."
(overlay-put ov 'priority 111)
;; No (extra) prefix for the first line.
(overlay-put ov 'line-prefix "")
- ;; `display' is better
- ;; (http://debbugs.gnu.org/18285, http://debbugs.gnu.org/20847),
- ;; but it doesn't work on 0-length overlays.
- (if (< (overlay-start ov) (overlay-end ov))
- (overlay-put ov 'display disp)
- (overlay-put ov 'after-string disp)
- (overlay-put ov 'invisible t))
- (overlay-put ov 'face 'default)
+ (overlay-put ov 'after-string disp)
+ ;; `display' is better than `invisible':
+ ;; https://debbugs.gnu.org/18285
+ ;; https://debbugs.gnu.org/20847
+ ;; https://debbugs.gnu.org/42521
+ (overlay-put ov 'display "")
(overlay-put ov 'window (selected-window)))))
(defun company-pseudo-tooltip-guard ()
@@ -2996,6 +3079,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(overlay-put company-pseudo-tooltip-overlay
'company-guard (company-pseudo-tooltip-guard)))
(company-pseudo-tooltip-unhide))
+ (show (setq company--tooltip-current-width 0))
(hide (company-pseudo-tooltip-hide)
(setq company-tooltip-offset 0))
(update (when (overlayp company-pseudo-tooltip-overlay)
@@ -3089,8 +3173,10 @@ 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))
- (`post-command (company-preview-show-at-point (point)
- (nth company-selection
company-candidates)))
+ (`post-command
+ (when company-selection
+ (company-preview-show-at-point (point)
+ (nth company-selection
company-candidates))))
(`hide (company-preview-hide))))
(defun company-preview-if-just-one-frontend (command)
@@ -3166,59 +3252,61 @@ Delay is determined by `company-tooltip-idle-delay'."
(run-with-idle-timer company-echo-delay nil 'company-echo-show
getter)))
(defun company-echo-format ()
-
- (let ((limit (window-body-width (minibuffer-window)))
- (len -1)
- ;; Roll to selection.
- (candidates (nthcdr company-selection company-candidates))
- (i (if company-show-numbers company-selection 99999))
- comp msg)
-
- (while candidates
- (setq comp (company-reformat (company--clean-string (pop candidates)))
- len (+ len 1 (length comp)))
- (if (< i 10)
- ;; Add number.
- (progn
- (setq comp (propertize (format "%d: %s" i comp)
- 'face 'company-echo))
- (cl-incf len 3)
- (cl-incf i)
- (add-text-properties 3 (+ 3 (string-width company-common))
- '(face company-echo-common) comp))
- (setq comp (propertize comp 'face 'company-echo))
- (add-text-properties 0 (string-width company-common)
- '(face company-echo-common) comp))
- (if (>= len limit)
- (setq candidates nil)
- (push comp msg)))
-
- (mapconcat 'identity (nreverse msg) " ")))
+ (let ((selection (or company-selection 0)))
+ (let ((limit (window-body-width (minibuffer-window)))
+ (len -1)
+ ;; Roll to selection.
+ (candidates (nthcdr selection company-candidates))
+ (i (if company-show-numbers selection 99999))
+ comp msg)
+
+ (while candidates
+ (setq comp (company-reformat (company--clean-string (pop candidates)))
+ len (+ len 1 (length comp)))
+ (if (< i 10)
+ ;; Add number.
+ (progn
+ (setq comp (propertize (format "%d: %s" i comp)
+ 'face 'company-echo))
+ (cl-incf len 3)
+ (cl-incf i)
+ ;; FIXME: Add support for the `match' backend action, and thus,
+ ;; non-prefix matches.
+ (add-text-properties 3 (+ 3 (string-width (or company-common
"")))
+ '(face company-echo-common) comp))
+ (setq comp (propertize comp 'face 'company-echo))
+ (add-text-properties 0 (string-width (or company-common ""))
+ '(face company-echo-common) comp))
+ (if (>= len limit)
+ (setq candidates nil)
+ (push comp msg)))
+
+ (mapconcat 'identity (nreverse msg) " "))))
(defun company-echo-strip-common-format ()
-
- (let ((limit (window-body-width (minibuffer-window)))
- (len (+ (length company-prefix) 2))
- ;; Roll to selection.
- (candidates (nthcdr company-selection company-candidates))
- (i (if company-show-numbers company-selection 99999))
- msg comp)
-
- (while candidates
- (setq comp (company-strip-prefix (pop candidates))
- len (+ len 2 (length comp)))
- (when (< i 10)
- ;; Add number.
- (setq comp (format "%s (%d)" comp i))
- (cl-incf len 4)
- (cl-incf i))
- (if (>= len limit)
- (setq candidates nil)
- (push (propertize comp 'face 'company-echo) msg)))
-
- (concat (propertize company-prefix 'face 'company-echo-common) "{"
- (mapconcat 'identity (nreverse msg) ", ")
- "}")))
+ (let ((selection (or company-selection 0)))
+ (let ((limit (window-body-width (minibuffer-window)))
+ (len (+ (length company-prefix) 2))
+ ;; Roll to selection.
+ (candidates (nthcdr selection company-candidates))
+ (i (if company-show-numbers selection 99999))
+ msg comp)
+
+ (while candidates
+ (setq comp (company-strip-prefix (pop candidates))
+ len (+ len 2 (length comp)))
+ (when (< i 10)
+ ;; Add number.
+ (setq comp (format "%s (%d)" comp i))
+ (cl-incf len 4)
+ (cl-incf i))
+ (if (>= len limit)
+ (setq candidates nil)
+ (push (propertize comp 'face 'company-echo) msg)))
+
+ (concat (propertize company-prefix 'face 'company-echo-common) "{"
+ (mapconcat 'identity (nreverse msg) ", ")
+ "}"))))
(defun company-echo-hide ()
(unless (equal company-echo-last-msg "")
diff --git a/test/core-tests.el b/test/core-tests.el
index 63feca2..5b8b9d4 100644
--- a/test/core-tests.el
+++ b/test/core-tests.el
@@ -258,7 +258,7 @@
(insert "ab")
(company-mode)
(let (company-frontends
- company-auto-complete
+ company-auto-commit
(company-require-match t)
(company-backends
(list (lambda (command &optional _)
@@ -358,13 +358,13 @@
(should (string= "a" (buffer-string)))
(should (null company-candidates)))))
-(ert-deftest company-auto-complete-explicit ()
+(ert-deftest company-auto-commit-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
- (company-auto-complete 'company-explicit-action-p)
- (company-auto-complete-chars '(? ))
+ (company-auto-commit 'company-explicit-action-p)
+ (company-auto-commit-chars '(? ))
(company-backends
(list (lambda (command &optional _)
(cl-case command
@@ -376,14 +376,14 @@
(company-call 'self-insert-command 1))
(should (string= "abcd " (buffer-string))))))
-(ert-deftest company-auto-complete-with-electric-pair ()
+(ert-deftest company-auto-commit-with-electric-pair ()
(with-temp-buffer
(insert "foo(ab)")
(forward-char -1)
(company-mode)
(let (company-frontends
- (company-auto-complete t)
- (company-auto-complete-chars '(? ?\)))
+ (company-auto-commit t)
+ (company-auto-commit-chars '(? ?\)))
(company-backends
(list (lambda (command &optional _)
(cl-case command
@@ -401,13 +401,13 @@
(electric-pair-mode -1)))
(should (string= "foo(abcd)" (buffer-string))))))
-(ert-deftest company-no-auto-complete-when-idle ()
+(ert-deftest company-no-auto-commit-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
- (company-auto-complete 'company-explicit-action-p)
- (company-auto-complete-chars '(? ))
+ (company-auto-commit 'company-explicit-action-p)
+ (company-auto-commit-chars '(? ))
(company-minimum-prefix-length 2)
(company-backends
(list (lambda (command &optional _)
@@ -591,3 +591,128 @@
(set-window-buffer nil (current-buffer))
(should (= (company--column) 0))
(should (= (company--row) 2)))))
+
+(ert-deftest company-set-nil-selection ()
+ (let ((company-selection 1)
+ (company-candidates-length 10)
+ (company-selection-changed nil)
+ (company-frontends nil))
+ (company-set-selection nil)
+ (should (eq company-selection nil))
+ (should (eq company-selection-changed t))))
+
+(ert-deftest company-update-candidates-nil-selection ()
+ (let ((company-selection nil)
+ (company-backend #'ignore)
+ company-candidates
+ company-candidates-length
+ company-candidates-cache
+ company-common
+ company-selection-default
+ (company-prefix "ab"))
+ (company-update-candidates '("abcd" "abcde" "abcdf"))
+ (should (null company-selection)))
+
+ (let* ((company-selection 1)
+ (company-backend #'ignore)
+ (company-candidates '("abc" "abdc" "abe"))
+ company-candidates-length
+ company-candidates-cache
+ company-common
+ company-selection-default
+ (company-prefix "ab")
+ (company-selection-changed t))
+ (company-update-candidates '("abcd" "abcde" "abcdf"))
+ (should (null company-selection))))
+
+(ert-deftest company-select-next ()
+ (cl-letf (((symbol-function 'company-manual-begin) (lambda () t))
+ (company-selection 1)
+ (company-candidates-length 10)
+ (company-selection-default 0)
+ (company-selection-wrap-around nil)
+ (company-frontends nil))
+ ;; Not wrap
+ (company-select-next 5)
+ (should (eq company-selection 6))
+
+ (company-select-next 5)
+ (should (eq company-selection 9))
+
+ (company-select-next -2)
+ (should (eq company-selection 7))
+
+ ;; Nil selection
+ (setq company-selection nil)
+ (company-select-next 5)
+ (should (eq company-selection 5))
+
+ (setq company-selection nil)
+ (company-select-next -1)
+ (should (eq company-selection 0))
+
+ ;; Wrap
+ (setq company-selection-wrap-around t)
+ (setq company-selection 7)
+ (company-select-next 5)
+ (should (eq company-selection 2))
+
+ ;; Nil selection
+ (setq company-selection nil)
+ (company-select-next 11)
+ (should (eq company-selection 1))
+
+ (setq company-selection nil)
+ (company-select-next -10)
+ (should (eq company-selection 0))))
+
+(ert-deftest company-select-next-default-selection-nil ()
+ (cl-letf (((symbol-function 'company-manual-begin) (lambda () t))
+ (company-selection 1)
+ (company-candidates-length 10)
+ (company-selection-default nil)
+ (company-selection-wrap-around nil)
+ (company-frontends nil))
+ ;; Not wrap
+ (company-select-next 5)
+ (should (eq company-selection 6))
+
+ (company-select-next 5)
+ (should (eq company-selection 9))
+
+ (company-select-next -10)
+ (should (eq company-selection nil))
+
+ ;; Nil selection
+ (setq company-selection nil)
+ (company-select-next 5)
+ (should (eq company-selection 4))
+
+ (setq company-selection nil)
+ (company-select-next -1)
+ (should (eq company-selection nil))
+
+ ;; Wrap
+ (setq company-selection-wrap-around t)
+ (setq company-selection 7)
+ (company-select-next 5)
+ (should (eq company-selection 1))
+
+ (setq company-selection 0)
+ (company-select-next -1)
+ (should (eq company-selection nil))
+
+ (setq company-selection 0)
+ (company-select-next -11)
+ (should (eq company-selection 0))
+
+ ;; Nil selection
+ (setq company-selection nil)
+ (company-select-next 11)
+ (should (eq company-selection nil))
+
+ (setq company-selection nil)
+ (company-select-next -10)
+ (should (eq company-selection 0))))
+
+;;; core-tests.el ends here.
diff --git a/test/frontends-tests.el b/test/frontends-tests.el
index e74b024..199467a 100644
--- a/test/frontends-tests.el
+++ b/test/frontends-tests.el
@@ -215,7 +215,7 @@
"avatar"))
(company-candidates-length 2)
(company-backend 'ignore))
- (should (equal '(" avalis‗e "
+ (should (equal '(" avalis?e "
" avatar ")
(company--create-lines 0 999)))))
