daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/company/company-abbrev.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-bbdb.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(require 'company)
(require 'cl-lib)

2
lisp/company/company-capf.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

23
lisp/company/company-clang.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -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)

3
lisp/company/company-cmake.el
View File

@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -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.")

2
lisp/company/company-css.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;

2
lisp/company/company-dabbrev-code.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-dabbrev.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

186
lisp/company/company-eclim.el
View File

@@ -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 <http://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

4
lisp/company/company-elisp.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,7 +37,7 @@
(defcustom company-elisp-detect-function-context t
"If enabled, offer Lisp functions only in appropriate contexts.
Functions are offered for completion only after ' and \(."
Functions are offered for completion only after \\=' and \(."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))

2
lisp/company/company-etags.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-files.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

31
lisp/company/company-gtags.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -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))

2
lisp/company/company-ispell.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-keywords.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-nxml.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-oddmuse.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

8
lisp/company/company-pkg.el
View File

@@ -1,11 +1,11 @@
(define-package "company" "20200616.2354" "Modular text completion framework"
(define-package "company" "20210103.1124" "Modular text completion framework"
'((emacs "24.3"))
:commit "1f56bec0ba7ce336eb8661b4d34e4b024d7dd04c" :keywords
'("abbrev" "convenience" "matching")
:authors
:commit "6116c4617a7934acfe84cb82a058e9b198f0f480" :authors
'(("Nikolaj Schumacher"))
:maintainer
'("Dmitry Gutov" . "dgutov@yandex.ru")
:keywords
'("abbrev" "convenience" "matching")
:url "http://company-mode.github.io/")
;; Local Variables:
;; no-byte-compile: t

2
lisp/company/company-semantic.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

2
lisp/company/company-template.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:

2
lisp/company/company-tempo.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:

132
lisp/company/company-tng.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -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
(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)))
(define-obsolete-function-alias 'company-tng-configure-default 'company-tng-mode "0.9.14"
"Applies the default configuration to enable company-tng.")
(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.
(declare-function eglot--snippet-expansion-fn "eglot")
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."
;;;###autoload
(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

123
lisp/company/company-xcode.el
View File

@@ -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 <http://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

13
lisp/company/company-yasnippet.el
View File

@@ -17,7 +17,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -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)
@@ -137,18 +138,18 @@ shadow backends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
(add-hook \\='js-mode-hook
(lambda ()
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
(set (make-local-variable \\='company-backends)
\\='((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
(push \\='(company-semantic :with company-yasnippet) company-backends)
* Not in `company-backends', just bound to a key.
(global-set-key (kbd \"C-c y\") 'company-yasnippet)
(global-set-key (kbd \"C-c y\") \\='company-yasnippet)
"
(interactive (list 'interactive))
(cl-case command

495
lisp/company/company.el
View File

@@ -5,7 +5,7 @@
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
;; Version: 0.9.12
;; Version: 0.9.13
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3"))
@@ -22,7 +22,7 @@
;; 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/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -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)
@@ -539,39 +543,60 @@ prefix it was started from."
:type 'boolean
:package-version '(company . "0.8.0"))
(defcustom company-abort-on-unique-match t
"If non-nil, typing a full unique match aborts completion.
You can still invoke `company-complete' manually to run the
`post-completion' handler, though.
If it's nil, completion will remain active until you type a prefix that
doesn't match anything or finish it manually, e.g. with RET."
:type 'boolean)
(defcustom company-require-match 'company-explicit-action-p
"If enabled, disallow non-matching input.
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 +613,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 +767,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 +1119,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 +1130,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)
@@ -1173,17 +1198,28 @@ can retrieve meta-data for them."
(string-match-p "\\`company-" (symbol-name this-command)))))))
(defun company-call-frontends (command)
(dolist (frontend company-frontends)
(condition-case-unless-debug err
(funcall frontend command)
(error (error "Company: frontend %s error \"%s\" on command %s"
frontend (error-message-string err) command)))))
(cl-loop for frontend in company-frontends collect
(condition-case-unless-debug err
(funcall frontend command)
(error (error "Company: frontend %s error \"%s\" on command %s"
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 +1238,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 +1251,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 +1542,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)
@@ -1569,7 +1606,8 @@ prefix match (same case) will be prioritized."
(- company-point (length company-prefix))))
(company-calculate-candidates new-prefix ignore-case))))
(cond
((company--unique-match-p c new-prefix ignore-case)
((and company-abort-on-unique-match
(company--unique-match-p c new-prefix ignore-case))
;; Handle it like completion was aborted, to differentiate from user
;; calling one of Company's commands to insert the candidate,
;; not to trigger template expansion, etc.
@@ -1580,12 +1618,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))
@@ -1611,7 +1648,8 @@ prefix match (same case) will be prioritized."
company-backend backend
c (company-calculate-candidates company-prefix ignore-case))
(cond
((and (company--unique-match-p c company-prefix ignore-case)
((and company-abort-on-unique-match
(company--unique-match-p c company-prefix ignore-case)
(if company--manual-action
;; If `company-manual-begin' was called, the user
;; really wants something to happen. Otherwise...
@@ -1655,7 +1693,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 +1857,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 +1898,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 +1914,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 +2057,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 +2070,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 +2110,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)
@@ -2114,31 +2163,19 @@ With ARG, move by that many elements."
(defun company--event-col-row (event)
(company--posn-col-row (event-start event)))
(defvar company-mouse-event nil
"Holds the mouse event from `company-select-mouse'.
For use in the `select-mouse' frontend action. `let'-bound.")
(defun company-select-mouse (event)
"Select the candidate picked by the mouse."
(interactive "e")
(let ((event-col-row (company--event-col-row event))
(ovl-row (company--row))
(ovl-height (and company-pseudo-tooltip-overlay
(min (overlay-get company-pseudo-tooltip-overlay
'company-height)
company-candidates-length))))
(if (and ovl-height
(company--inside-tooltip-p event-col-row ovl-row ovl-height))
(progn
(company-set-selection (+ (cdr event-col-row)
(1- company-tooltip-offset)
(if (and (eq company-tooltip-offset-display 'lines)
(not (zerop company-tooltip-offset)))
-1 0)
(- ovl-row)
(if (< ovl-height 0)
(- 1 ovl-height)
0)))
t)
(company-abort)
(company--unread-this-command-keys)
nil)))
(or (let ((company-mouse-event event))
(cl-some #'identity (company-call-frontends 'select-mouse)))
(progn
(company-abort)
(company--unread-this-command-keys)
nil)))
(defun company-complete-mouse (event)
"Insert the candidate picked by the mouse."
@@ -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)
@@ -2398,7 +2436,7 @@ It defaults to 0.
CALLBACK is a function called with the selected result if the user
successfully completes the input.
Example: \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
Example: \(company-begin-with \\='\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
(let ((begin-marker (copy-marker (point) t)))
(company-begin-backend
(lambda (command &optional arg &rest ignored)
@@ -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))))))
(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))
(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 ()
@@ -2983,23 +3066,43 @@ Returns a negative number if the tooltip should be displayed above point."
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
(unless (when (overlayp company-pseudo-tooltip-overlay)
(let* ((ov company-pseudo-tooltip-overlay)
(old-height (overlay-get ov 'company-height))
(new-height (company--pseudo-tooltip-height)))
(and
(>= (* old-height new-height) 0)
(>= (abs old-height) (abs new-height))
(equal (company-pseudo-tooltip-guard)
(overlay-get ov 'company-guard)))))
(let* ((ov company-pseudo-tooltip-overlay)
(old-height (overlay-get ov 'company-height))
(new-height (company--pseudo-tooltip-height)))
(and
(>= (* old-height new-height) 0)
(>= (abs old-height) (abs new-height))
(equal (company-pseudo-tooltip-guard)
(overlay-get ov 'company-guard)))))
;; Redraw needed.
(company-pseudo-tooltip-show-at-point (point) (length company-prefix))
(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)
(company-pseudo-tooltip-edit company-selection)))))
(company-pseudo-tooltip-edit company-selection)))
(select-mouse
(let ((event-col-row (company--event-col-row company-mouse-event))
(ovl-row (company--row))
(ovl-height (and company-pseudo-tooltip-overlay
(min (overlay-get company-pseudo-tooltip-overlay
'company-height)
company-candidates-length))))
(cond ((and ovl-height
(company--inside-tooltip-p event-col-row ovl-row ovl-height))
(company-set-selection (+ (cdr event-col-row)
(1- company-tooltip-offset)
(if (and (eq company-tooltip-offset-display 'lines)
(not (zerop company-tooltip-offset)))
-1 0)
(- ovl-row)
(if (< ovl-height 0)
(- 1 ovl-height)
0)))
t))))))
(defun company-pseudo-tooltip-unless-just-one-frontend (command)
"`company-pseudo-tooltip-frontend', but not shown for single candidates."
@@ -3089,8 +3192,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 +3271,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 ((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)
(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)
;; 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)))
(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) " ")))
(mapconcat 'identity (nreverse msg) " "))))
(defun company-echo-strip-common-format ()
(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)
(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)))
(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) ", ")
"}")))
(concat (propertize company-prefix 'face 'company-echo-common) "{"
(mapconcat 'identity (nreverse msg) ", ")
"}"))))
(defun company-echo-hide ()
(unless (equal company-echo-last-msg "")