[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 7a2deff 173/173: Merge commit '212c8fc3101781a2f1c55ca6177
|
From: |
Dmitry Gutov |
|
Subject: |
[elpa] master 7a2deff 173/173: Merge commit '212c8fc3101781a2f1c55ca61772eb75a2046e87' from company |
|
Date: |
Thu, 23 Jun 2016 00:28:48 +0000 (UTC) |
branch: master
commit 7a2deffbe4a7865b42e31ad2eabd05221468f07c
Merge: 24149b0 212c8fc
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>
Merge commit '212c8fc3101781a2f1c55ca61772eb75a2046e87' from company
---
packages/company/.travis.yml | 3 +-
packages/company/Makefile | 4 +-
packages/company/NEWS.md | 47 ++
packages/company/README.md | 2 +-
packages/company/company-abbrev.el | 9 +-
packages/company/company-bbdb.el | 10 +-
packages/company/company-capf.el | 36 +-
packages/company/company-clang.el | 44 +-
packages/company/company-cmake.el | 6 +-
packages/company/company-css.el | 10 +-
packages/company/company-dabbrev-code.el | 16 +-
packages/company/company-dabbrev.el | 110 ++--
packages/company/company-eclim.el | 25 +-
packages/company/company-elisp.el | 6 +-
packages/company/company-etags.el | 31 +-
packages/company/company-files.el | 63 ++-
packages/company/company-gtags.el | 7 +-
packages/company/company-ispell.el | 20 +-
packages/company/company-keywords.el | 39 +-
packages/company/company-nxml.el | 4 +-
packages/company/company-oddmuse.el | 6 +-
packages/company/company-pysmell.el | 69 ---
packages/company/company-ropemacs.el | 72 ---
packages/company/company-semantic.el | 61 ++-
packages/company/company-template.el | 65 ++-
packages/company/company-tempo.el | 20 +-
packages/company/company-xcode.el | 6 +-
packages/company/company-yasnippet.el | 69 ++-
packages/company/company.el | 836 ++++++++++++++++++++----------
packages/company/test/async-tests.el | 4 +-
packages/company/test/bbdb-tests.el | 46 ++
packages/company/test/clang-tests.el | 17 +-
packages/company/test/core-tests.el | 25 +-
packages/company/test/frontends-tests.el | 99 +++-
packages/company/test/template-tests.el | 60 ++-
35 files changed, 1238 insertions(+), 709 deletions(-)
diff --git a/packages/company/.travis.yml b/packages/company/.travis.yml
index ed76f79..6993df8 100644
--- a/packages/company/.travis.yml
+++ b/packages/company/.travis.yml
@@ -1,6 +1,6 @@
# https://github.com/rolandwalker/emacs-travis
-language: emacs-lisp
+language: generic
env:
matrix:
@@ -16,6 +16,7 @@ install:
- if [ "$EMACS" = "emacs-snapshot" ]; then
sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
sudo apt-get update -qq &&
+ sudo apt-get -qq -f install &&
sudo apt-get install -qq emacs-snapshot;
fi
diff --git a/packages/company/Makefile b/packages/company/Makefile
index fada444..015f3ac 100644
--- a/packages/company/Makefile
+++ b/packages/company/Makefile
@@ -4,13 +4,13 @@ EMACS=emacs
package: *.el
@ver=`grep -o "Version: .*" company.el | cut -c 10-`; \
- tar cjvf company-$$ver.tar.bz2 --mode 644 `git ls-files '*.el' | xargs`
+ tar cjvf company-$$ver.tar.bz2 --mode 644 $$(find . -name \*.el)
elpa: *.el
@version=`grep -o "Version: .*" company.el | cut -c 10-`; \
dir=company-$$version; \
mkdir -p "$$dir"; \
- cp `git ls-files '*.el' | xargs` company-$$version; \
+ cp $$(find . -name \*.el) company-$$version; \
echo "(define-package \"company\" \"$$version\" \
\"Modular in-buffer completion framework\")" \
> "$$dir"/company-pkg.el; \
diff --git a/packages/company/NEWS.md b/packages/company/NEWS.md
index c7a1afe..758f0be 100644
--- a/packages/company/NEWS.md
+++ b/packages/company/NEWS.md
@@ -1,5 +1,52 @@
# History of user-visible changes
+## 2016-06-23 (0.9.0)
+
+* Group of backends can now contain keyword `:separate`, which makes candidates
+ from different backends sorted separately in the combined list.
+* New frontend `company-pseudo-tooltip-unless-just-one-frontend-with-delay`.
+* New transformer `company-sort-prefer-same-case-prefix`.
+* The value of `company-dabbrev-ignore-buffers` can also be a function.
+* `company-files` has been moved to right after `company-capf` in
+ `company-backends`
+ ([#463](https://github.com/company-mode/company-mode/issues/463)).
+* `company-semantic-insert-arguments`: New option. Like in `company-clang`.
+* `company-semantic-begin-after-member-access`: New option. Similar to the one
+ in `company-clang`.
+* `company-capf` accepts `:company-prefix-length` property value.
+* New face `company-tooltip-annotation-selection`, used for the annotation in
+ the selected tooltip line.
+* `company-clang-objc-templatify` has been renamed to
+ `company-template-objc-templatify`.
+* New user option `company-etags-everywhere`.
+* `company-yasnippet` supports `yas-key-syntaxes` better. But we use them in
the
+ reverse order, preferring the longest key prefix that matches anything. And
we
+ only consider trigger key prefixes that are at least as long as the symbol at
+ point, which effectively means skipping the `"w"` element
+ ([#422](https://github.com/company-mode/company-mode/issues/422)).
+* New user option `company-search-regexp-function`.
+* Completion is not started automatically when a keyboard macro is being
+ recorded ([#374](https://github.com/company-mode/company-mode/issues/374)).
+* New command `company-indent-or-complete-common`.
+* Backend command `doc-buffer` now can also return a cons of buffer and window
+ start position.
+* Backend command `ignore-case` has been documented.
+* `company-template-c-like-templatify` does not replace the default argument
+ values with `argN` anymore
+ ([#336](https://github.com/company-mode/company-mode/issues/336)). This
+ affects `company-clang` and all third-party backends that use this function.
+* Likewise for `company-clang-objc-templatify`.
+* `company-template-add-field` calling convention has changed.
+* New user option `company-dabbrev-ignore-invisible`.
+* `company-ropemacs` was removed. `ropemacs` supports completion via
+ `completion-at-point-functions` starting with version 0.8.
+* `company-pysmell` was removed.
+* `company-select-next`, `company-select-previous`,
+ `company-select-next-or-abort`, `company-select-previous-or-abort` and
+ `company-complete-common-or-cycle` accept a numeric argument.
+* The documentation buffer window can be scrolled with the mouse wheel.
+* New command `company-diag`. Use it in bug reports.
+
## 2015-02-02 (0.8.10)
* New variable `company-lighter-base`.
diff --git a/packages/company/README.md b/packages/company/README.md
index 4f79bbc..1e0e5e6 100644
--- a/packages/company/README.md
+++ b/packages/company/README.md
@@ -1,4 +1,4 @@
See the [homepage](http://company-mode.github.com/).
-[](http://githalytics.com/company-mode/company-mode)
[](https://travis-ci.org/company-mode/company-mode)
+[](http://melpa.milkbox.net/#/company)
diff --git a/packages/company/company-abbrev.el
b/packages/company/company-abbrev.el
index a454aaa..24ec3b7 100644
--- a/packages/company/company-abbrev.el
+++ b/packages/company/company-abbrev.el
@@ -1,6 +1,6 @@
-;;; company-abbrev.el --- company-mode completion back-end for abbrev
+;;; company-abbrev.el --- company-mode completion backend for abbrev
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -35,7 +35,7 @@
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
- "`company-mode' completion back-end for abbrev."
+ "`company-mode' completion backend for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
@@ -44,8 +44,7 @@
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
- (meta (abbrev-expansion arg))
- (require-match t)))
+ (meta (abbrev-expansion arg))))
(provide 'company-abbrev)
;;; company-abbrev.el ends here
diff --git a/packages/company/company-bbdb.el b/packages/company/company-bbdb.el
index 58be84c..872e1fc 100644
--- a/packages/company/company-bbdb.el
+++ b/packages/company/company-bbdb.el
@@ -1,6 +1,6 @@
-;;; company-bbdb.el --- company-mode completion back-end for BBDB in
message-mode
+;;; company-bbdb.el --- company-mode completion backend for BBDB in
message-mode
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
;; Author: Jan Tatarik <address@hidden>
@@ -28,7 +28,7 @@
(declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
- "Completion back-end for BBDB."
+ "Completion backend for BBDB."
:group 'company)
(defcustom company-bbdb-modes '(message-mode)
@@ -44,13 +44,13 @@
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
- "`company-mode' completion back-end for BBDB."
+ "`company-mode' completion backend for BBDB."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (memq major-mode company-bbdb-modes)
(featurep 'bbdb-com)
- (looking-back "^\\(To\\|Cc\\|Bcc\\): *\\(.*\\)"
+ (looking-back "^\\(To\\|Cc\\|Bcc\\): *.*? *\\([^,;]*\\)"
(line-beginning-position))
(match-string-no-properties 2)))
(candidates (company-bbdb--candidates arg))
diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el
index 4962a26..866fd62 100644
--- a/packages/company/company-capf.el
+++ b/packages/company/company-capf.el
@@ -1,6 +1,6 @@
-;;; company-capf.el --- company-mode completion-at-point-functions back-end
-*- lexical-binding: t -*-
+;;; company-capf.el --- company-mode completion-at-point-functions backend -*-
lexical-binding: t -*-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <address@hidden>
@@ -48,22 +48,36 @@
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions)))
+ (completion-at-point-functions (company--capf-workaround))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
- (when (and (consp (cdr data)) (numberp (nth 1 data))) data)))
+ (when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
+
+(declare-function python-shell-get-process "python")
+
+(defun company--capf-workaround ()
+ ;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
+ (if (or (not (listp completion-at-point-functions))
+ (not (memq 'python-completion-complete-at-point
completion-at-point-functions))
+ (python-shell-get-process))
+ completion-at-point-functions
+ (remq 'python-completion-complete-at-point completion-at-point-functions)))
(defun company-capf (command &optional arg &rest _args)
- "`company-mode' back-end using `completion-at-point-functions'."
+ "`company-mode' backend using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
- (if (> (nth 2 res) (point))
- 'stop
- (buffer-substring-no-properties (nth 1 res) (point))))))
+ (let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
+ (prefix (buffer-substring-no-properties (nth 1 res) (point))))
+ (cond
+ ((> (nth 2 res) (point)) 'stop)
+ (length (cons prefix length))
+ (t prefix))))))
(`candidates
(let ((res (company--capf-data)))
(when res
@@ -95,16 +109,16 @@
(cdr (assq 'display-sort-function meta))))))
(`match
;; Can't just use 0 when base-size (see above) is non-zero.
- (let ((start (if (get-text-property 0 'font-lock-face arg)
+ (let ((start (if (get-text-property 0 'face arg)
0
- (next-single-property-change 0 'font-lock-face arg))))
+ (next-single-property-change 0 'face arg))))
(when start
;; completions-common-part comes first, but we can't just look for
this
;; value because it can be in a list.
(or
- (let ((value (get-text-property start 'font-lock-face arg)))
+ (let ((value (get-text-property start 'face arg)))
(text-property-not-all start (length arg)
- 'font-lock-face value arg))
+ 'face value arg))
(length arg)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
diff --git a/packages/company/company-clang.el
b/packages/company/company-clang.el
index e85e865..54d4b9b 100644
--- a/packages/company/company-clang.el
+++ b/packages/company/company-clang.el
@@ -1,6 +1,6 @@
-;;; company-clang.el --- company-mode completion back-end for Clang -*-
lexical-binding: t -*-
+;;; company-clang.el --- company-mode completion backend for Clang -*-
lexical-binding: t -*-
-;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -30,7 +30,7 @@
(require 'cl-lib)
(defgroup company-clang nil
- "Completion back-end for Clang."
+ "Completion backend for Clang."
:group 'company)
(defcustom company-clang-executable
@@ -144,6 +144,18 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(get-text-property 0 'meta candidate))
(defun company-clang--annotation (candidate)
+ (let ((ann (company-clang--annotation-1 candidate)))
+ (if (not (and ann (string-prefix-p "(*)" ann)))
+ ann
+ (with-temp-buffer
+ (insert ann)
+ (search-backward ")")
+ (let ((pt (1+ (point))))
+ (re-search-forward ".\\_>" nil t)
+ (delete-region pt (point)))
+ (buffer-string)))))
+
+(defun company-clang--annotation-1 (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
@@ -191,9 +203,11 @@ or automatically through a custom
`company-clang-prefix-guesser'."
(buf (get-buffer-create "*clang-output*"))
;; Looks unnecessary in Emacs 25.1 and later.
(process-adaptive-read-buffering nil))
- (with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf)
(funcall callback nil)
+ (with-current-buffer buf
+ (erase-buffer)
+ (setq buffer-undo-list t))
(let ((process (apply #'start-process "company-clang" buf
company-clang-executable args)))
(set-process-sentinel
@@ -275,26 +289,8 @@ or automatically through a custom
`company-clang-prefix-guesser'."
ver))
0)))
-(defun company-clang-objc-templatify (selector)
- (let* ((end (point-marker))
- (beg (- (point) (length selector) 1))
- (templ (company-template-declare-template beg end))
- (cnt 0))
- (save-excursion
- (goto-char beg)
- (catch 'stop
- (while (search-forward ":" end t)
- (when (looking-at "([^)]*) ?")
- (delete-region (match-beginning 0) (match-end 0)))
- (company-template-add-field templ (point) (format "arg%d" cnt))
- (if (< (point) end)
- (insert " ")
- (throw 'stop t))
- (cl-incf cnt))))
- (company-template-move-to-first templ)))
-
(defun company-clang (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Clang.
+ "`company-mode' completion backend for Clang.
Clang is a parser for C and ObjC. Clang version 1.1 or newer is required.
Additional command line arguments can be specified in
@@ -327,7 +323,7 @@ passed via standard input."
(when (and company-clang-insert-arguments anno)
(insert anno)
(if (string-match "\\`:[^:]" anno)
- (company-clang-objc-templatify anno)
+ (company-template-objc-templatify anno)
(company-template-c-like-templatify
(concat arg anno))))))))
diff --git a/packages/company/company-cmake.el
b/packages/company/company-cmake.el
index e2962f5..010df32 100644
--- a/packages/company/company-cmake.el
+++ b/packages/company/company-cmake.el
@@ -1,4 +1,4 @@
-;;; company-cmake.el --- company-mode completion back-end for CMake
+;;; company-cmake.el --- company-mode completion backend for CMake
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
@@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-cmake nil
- "Completion back-end for CMake."
+ "Completion backend for CMake."
:group 'company)
(defcustom company-cmake-executable
@@ -178,7 +178,7 @@ They affect which types of symbols we get completion
candidates for.")
(point-max))))))
(defun company-cmake (command &optional arg &rest ignored)
- "`company-mode' completion back-end for CMake.
+ "`company-mode' completion backend for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
diff --git a/packages/company/company-css.el b/packages/company/company-css.el
index ec48653..cf8c683 100644
--- a/packages/company/company-css.el
+++ b/packages/company/company-css.el
@@ -1,4 +1,4 @@
-;;; company-css.el --- company-mode completion back-end for css-mode -*-
lexical-binding: t -*-
+;;; company-css.el --- company-mode completion backend for css-mode -*-
lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
@@ -26,6 +26,8 @@
(require 'company)
(require 'cl-lib)
+(declare-function web-mode-language-at-pos "web-mode" (&optional pos))
+
(defconst company-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
@@ -411,11 +413,13 @@ Returns \"\" if no property found, but feasible at this
position."
;;;###autoload
(defun company-css (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `css-mode'."
+ "`company-mode' completion backend for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
- (prefix (and (derived-mode-p 'css-mode)
+ (prefix (and (or (derived-mode-p 'css-mode)
+ (and (derived-mode-p 'web-mode)
+ (string= (web-mode-language-at-pos) "css")))
(or (company-grab company-css-tag-regexp 1)
(company-grab company-css-pseudo-regexp 1)
(company-grab company-css-property-value-regexp 2)
diff --git a/packages/company/company-dabbrev-code.el
b/packages/company/company-dabbrev-code.el
index 256b57f..9331087 100644
--- a/packages/company/company-dabbrev-code.el
+++ b/packages/company/company-dabbrev-code.el
@@ -1,4 +1,4 @@
-;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end for code
-*- lexical-binding: t -*-
+;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code
-*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
@@ -30,7 +30,7 @@
(require 'cl-lib)
(defgroup company-dabbrev-code nil
- "dabbrev-like completion back-end for code."
+ "dabbrev-like completion backend for code."
:group 'company)
(defcustom company-dabbrev-code-modes
@@ -40,10 +40,10 @@
"Modes that use `company-dabbrev-code'.
In all these modes (and their derivatives) `company-dabbrev-code' will
complete only symbols, not text in comments or strings. In other modes
-`company-dabbrev-code' will pass control to other back-ends
+`company-dabbrev-code' will pass control to other backends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
- :type '(choice (repeat (symbol :tag "Major mode"))
- (const tag "All modes" t)))
+ :type '(choice (repeat :tag "Some modes" (symbol :tag "Major mode"))
+ (const :tag "All modes" t)))
(defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers.
@@ -69,7 +69,7 @@ also `company-dabbrev-code-time-limit'."
"Non-nil to ignore case when collecting completion candidates."
:type 'boolean)
-(defsubst company-dabbrev-code--make-regexp (prefix)
+(defun company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
@@ -77,8 +77,8 @@ also `company-dabbrev-code-time-limit'."
;;;###autoload
(defun company-dabbrev-code (command &optional arg &rest ignored)
- "dabbrev-like `company-mode' back-end for code.
-The back-end looks for all symbols in the current buffer that aren't in
+ "dabbrev-like `company-mode' backend for code.
+The backend looks for all symbols in the current buffer that aren't in
comments or strings."
(interactive (list 'interactive))
(cl-case command
diff --git a/packages/company/company-dabbrev.el
b/packages/company/company-dabbrev.el
index 7519caf..b1a9def 100644
--- a/packages/company/company-dabbrev.el
+++ b/packages/company/company-dabbrev.el
@@ -1,6 +1,6 @@
-;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*-
lexical-binding: t -*-
+;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*-
lexical-binding: t -*-
-;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-dabbrev nil
- "dabbrev-like completion back-end."
+ "dabbrev-like completion backend."
:group 'company)
(defcustom company-dabbrev-other-buffers 'all
@@ -41,8 +41,11 @@ buffers with the same major mode. See also
`company-dabbrev-time-limit'."
(const :tag "All" all)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
- "Regexp matching the names of buffers to ignore."
- :type 'regexp)
+ "Regexp matching the names of buffers to ignore.
+Or a function that returns non-nil for such buffers."
+ :type '(choice (regexp :tag "Regexp")
+ (function :tag "Predicate"))
+ :package-version '(company . "0.9.0"))
(defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches."
@@ -74,46 +77,60 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
:type 'integer
:package-version '(company . "0.8.3"))
-(defmacro company-dabrev--time-limit-while (test start limit &rest body)
+(defcustom company-dabbrev-ignore-invisible nil
+ "Non-nil to skip invisible text."
+ :type 'boolean
+ :package-version '(company . "0.9.0"))
+
+(defmacro company-dabbrev--time-limit-while (test start limit freq &rest body)
(declare (indent 3) (debug t))
`(let ((company-time-limit-while-counter 0))
(catch 'done
(while ,test
,@body
(and ,limit
- (eq (cl-incf company-time-limit-while-counter) 25)
+ (= (cl-incf company-time-limit-while-counter) ,freq)
(setq company-time-limit-while-counter 0)
(> (float-time (time-since ,start)) ,limit)
(throw 'done 'company-time-out))))))
-(defsubst company-dabbrev--make-regexp (prefix)
- (concat "\\<" (if (equal prefix "")
- company-dabbrev-char-regexp
- (regexp-quote prefix))
- "\\(" company-dabbrev-char-regexp "\\)*\\>"))
+(defun company-dabbrev--make-regexp ()
+ (concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
- (let (match)
+ (cl-labels ((maybe-collect-match
+ ()
+ (let ((match (match-string-no-properties 0)))
+ (when (and (>= (length match)
company-dabbrev-minimum-length)
+ (not (and company-dabbrev-ignore-invisible
+ (invisible-p (match-beginning 0)))))
+ (push match symbols)))))
(goto-char (if pos (1- pos) (point-min)))
- ;; search before pos
- (company-dabrev--time-limit-while (re-search-backward regexp nil t)
- start limit
- (setq match (match-string-no-properties 0))
- (if (and ignore-comments (company-in-string-or-comment))
- (goto-char (nth 8 (syntax-ppss)))
- (when (>= (length match) company-dabbrev-minimum-length)
- (push match symbols))))
+ ;; Search before pos.
+ (let ((tmp-end (point)))
+ (company-dabbrev--time-limit-while (> tmp-end (point-min))
+ start limit 1
+ (ignore-errors
+ (forward-char -10000))
+ (forward-line 0)
+ (save-excursion
+ ;; Before, we used backward search, but it matches non-greedily,
and
+ ;; that forced us to use the "beginning/end of word" anchors in
+ ;; `company-dabbrev--make-regexp'. It's also about 2x slower.
+ (while (re-search-forward regexp tmp-end t)
+ (if (and ignore-comments (save-match-data
(company-in-string-or-comment)))
+ (re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
+ (maybe-collect-match))))
+ (setq tmp-end (point))))
(goto-char (or pos (point-min)))
- ;; search after pos
- (company-dabrev--time-limit-while (re-search-forward regexp nil t)
- start limit
- (setq match (match-string-no-properties 0))
- (if (and ignore-comments (company-in-string-or-comment))
+ ;; Search after pos.
+ (company-dabbrev--time-limit-while (re-search-forward regexp nil t)
+ start limit 25
+ (if (and ignore-comments (save-match-data
(company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
- (when (>= (length match) company-dabbrev-minimum-length)
- (push match symbols))))
+ (maybe-collect-match)))
symbols)))
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
@@ -123,29 +140,43 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
ignore-comments)))
(when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
- (with-current-buffer buffer
- (when (if (eq other-buffer-modes 'all)
- (not (string-match-p company-dabbrev-ignore-buffers
- (buffer-name)))
- (apply #'derived-mode-p other-buffer-modes))
- (setq symbols
- (company-dabbrev--search-buffer regexp nil symbols start
- limit ignore-comments))))
+ (unless (if (stringp company-dabbrev-ignore-buffers)
+ (string-match-p company-dabbrev-ignore-buffers
+ (buffer-name buffer))
+ (funcall company-dabbrev-ignore-buffers buffer))
+ (with-current-buffer buffer
+ (when (or (eq other-buffer-modes 'all)
+ (apply #'derived-mode-p other-buffer-modes))
+ (setq symbols
+ (company-dabbrev--search-buffer regexp nil symbols start
+ limit ignore-comments)))))
(and limit
(> (float-time (time-since start)) limit)
(cl-return))))
symbols))
+(defun company-dabbrev--prefix ()
+ ;; Not in the middle of a word.
+ (unless (looking-at company-dabbrev-char-regexp)
+ ;; Emacs can't do greedy backward-search.
+ (company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
+ company-dabbrev-char-regexp)
+ 1)))
+
+(defun company-dabbrev--filter (prefix candidates)
+ (let ((completion-ignore-case company-dabbrev-ignore-case))
+ (all-completions prefix candidates)))
+
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
- "dabbrev-like `company-mode' completion back-end."
+ "dabbrev-like `company-mode' completion backend."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
- (prefix (company-grab-word))
+ (prefix (company-dabbrev--prefix))
(candidates
(let* ((case-fold-search company-dabbrev-ignore-case)
- (words (company-dabbrev--search (company-dabbrev--make-regexp arg)
+ (words (company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase
company-dabbrev-other-buffers
(`t (list major-mode))
@@ -153,6 +184,7 @@ This variable affects both `company-dabbrev' and
`company-dabbrev-code'."
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
+ (setq words (company-dabbrev--filter arg words))
(if downcase-p
(mapcar 'downcase words)
words)))
diff --git a/packages/company/company-eclim.el
b/packages/company/company-eclim.el
index 1f1beae..b37f756 100644
--- a/packages/company/company-eclim.el
+++ b/packages/company/company-eclim.el
@@ -1,6 +1,6 @@
-;;; company-eclim.el --- company-mode completion back-end for Eclim
+;;; company-eclim.el --- company-mode completion backend for Eclim
-;; Copyright (C) 2009, 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -21,10 +21,10 @@
;;; Commentary:
;;
-;; Using `emacs-eclim' together with (or instead of) this back-end is
+;; Using `emacs-eclim' together with (or instead of) this backend is
;; recommended, as it allows you to use other Eclim features.
;;
-;; The alternative back-end provided by `emacs-eclim' uses `yasnippet'
+;; 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.
@@ -35,7 +35,7 @@
(require 'cl-lib)
(defgroup company-eclim nil
- "Completion back-end for Eclim."
+ "Completion backend for Eclim."
:group 'company)
(defun company-eclim-executable-find ()
@@ -48,7 +48,9 @@
(cl-return file)))))
(defcustom company-eclim-executable
- (or (executable-find "eclim") (company-eclim-executable-find))
+ (or (bound-and-true-p eclim-executable)
+ (executable-find "eclim")
+ (company-eclim-executable-find))
"Location of eclim executable."
:type 'file)
@@ -87,10 +89,11 @@ eclim can only complete correctly when the buffer has been
saved."
(defun company-eclim--project-dir ()
(if (eq company-eclim--project-dir 'unknown)
- (setq company-eclim--project-dir
- (directory-file-name
- (expand-file-name
- (locate-dominating-file buffer-file-name ".project"))))
+ (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 ()
@@ -153,7 +156,7 @@ eclim can only complete correctly when the buffer has been
saved."
prefix)))
(defun company-eclim (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Eclim.
+ "`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.
diff --git a/packages/company/company-elisp.el
b/packages/company/company-elisp.el
index 5efd8d0..3db0d8b 100644
--- a/packages/company/company-elisp.el
+++ b/packages/company/company-elisp.el
@@ -1,4 +1,4 @@
-;;; company-elisp.el --- company-mode completion back-end for Emacs Lisp -*-
lexical-binding: t -*-
+;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*-
lexical-binding: t -*-
;; Copyright (C) 2009, 2011-2013 Free Software Foundation, Inc.
@@ -31,7 +31,7 @@
(require 'find-func)
(defgroup company-elisp nil
- "Completion back-end for Emacs Lisp."
+ "Completion backend for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
@@ -193,7 +193,7 @@ first in the candidates list."
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Emacs Lisp."
+ "`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))
diff --git a/packages/company/company-etags.el
b/packages/company/company-etags.el
index 1c01c91..ef53213 100644
--- a/packages/company/company-etags.el
+++ b/packages/company/company-etags.el
@@ -1,4 +1,4 @@
-;;; company-etags.el --- company-mode completion back-end for etags
+;;; company-etags.el --- company-mode completion backend for etags
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@@ -30,7 +30,7 @@
(require 'etags)
(defgroup company-etags nil
- "Completion back-end for etags."
+ "Completion backend for etags."
:group 'company)
(defcustom company-etags-use-main-table-list t
@@ -45,17 +45,28 @@ buffer automatically."
:type 'boolean
:package-version '(company . "0.7.3"))
+(defcustom company-etags-everywhere nil
+ "Non-nil to offer completions in comments and strings.
+Set it to t or to a list of major modes."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Any supported mode" t)
+ (repeat :tag "Some major modes"
+ (symbol :tag "Major mode")))
+ :package-version '(company . "0.9.0"))
+
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
jde-mode pascal-mode perl-mode python-mode))
(defvar-local company-etags-buffer-table 'unknown)
(defun company-etags-find-table ()
- (let ((file (locate-dominating-file (or buffer-file-name
- default-directory)
- "TAGS")))
+ (let ((file (expand-file-name
+ "TAGS"
+ (locate-dominating-file (or buffer-file-name
+ default-directory)
+ "TAGS"))))
(when (and file (file-regular-p file))
- (list (expand-file-name file)))))
+ (list file))))
(defun company-etags-buffer-table ()
(or (and company-etags-use-main-table-list tags-table-list)
@@ -74,12 +85,14 @@ buffer automatically."
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
- "`company-mode' completion back-end for etags."
+ "`company-mode' completion backend for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
- (prefix (and (apply 'derived-mode-p company-etags-modes)
- (not (company-in-string-or-comment))
+ (prefix (and (apply #'derived-mode-p company-etags-modes)
+ (or (eq t company-etags-everywhere)
+ (apply #'derived-mode-p company-etags-everywhere)
+ (not (company-in-string-or-comment)))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))
diff --git a/packages/company/company-files.el
b/packages/company/company-files.el
index 7cfc500..c19d3d6 100644
--- a/packages/company/company-files.el
+++ b/packages/company/company-files.el
@@ -1,6 +1,6 @@
-;;; company-files.el --- company-mode completion back-end for file paths
+;;; company-files.el --- company-mode completion backend for file paths
-;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -30,9 +30,12 @@
(defun company-files--directory-files (dir prefix)
(ignore-errors
- (if (equal prefix "")
- (directory-files dir nil "\\`[^.]\\|\\`.[^.]")
- (file-name-all-completions prefix dir))))
+ ;; Don't use directory-files. It produces directories without trailing /.
+ (let ((comp (sort (file-name-all-completions prefix dir)
+ (lambda (s1 s2) (string-lessp (downcase s1) (downcase
s2))))))
+ (if (equal prefix "")
+ (delete "../" (delete "./" comp))
+ comp))))
(defvar company-files--regexps
(let* ((root (if (eq system-type 'windows-nt)
@@ -50,35 +53,47 @@
(and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
+ (company-files--connected-p file)
(setq dir (file-name-directory file))
(not (string-match "//" dir))
(file-exists-p dir)
- (file-name-all-completions (file-name-nondirectory file) dir)
file)))
+(defun company-files--connected-p (file)
+ (or (not (file-remote-p file))
+ (file-remote-p file nil t)))
+
+(defun company-files--trailing-slash-p (file)
+ ;; `file-directory-p' is very expensive on remotes. We are relying on
+ ;; `file-name-all-completions' returning directories with trailing / instead.
+ (let ((len (length file)))
+ (and (> len 0) (eq (aref file (1- len)) ?/))))
+
(defvar company-files--completion-cache nil)
(defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
- (key (list (file-name-nondirectory prefix)
+ (file (file-name-nondirectory prefix))
+ (key (list file
(expand-file-name dir)
(nth 5 (file-attributes dir))))
- (file (file-name-nondirectory prefix))
- (completion-ignore-case read-file-name-completion-ignore-case)
- candidates directories)
+ (completion-ignore-case read-file-name-completion-ignore-case))
(unless (company-file--keys-match-p key (car
company-files--completion-cache))
- (dolist (file (company-files--directory-files dir file))
- (setq file (concat dir file))
- (push file candidates)
- (when (file-directory-p file)
- (push file directories)))
- (dolist (directory (reverse directories))
- ;; Add one level of children.
- (dolist (child (company-files--directory-files directory ""))
- (push (concat directory
- (unless (eq (aref directory (1- (length directory)))
?/) "/")
- child) candidates)))
- (setq company-files--completion-cache (cons key (nreverse candidates))))
+ (let* ((candidates (mapcar (lambda (f) (concat dir f))
+ (company-files--directory-files dir file)))
+ (directories (unless (file-remote-p dir)
+ (cl-remove-if-not (lambda (f)
+ (and
(company-files--trailing-slash-p f)
+ (not (file-remote-p f))
+
(company-files--connected-p f)))
+ candidates)))
+ (children (and directories
+ (cl-mapcan (lambda (d)
+ (mapcar (lambda (c) (concat d c))
+
(company-files--directory-files d "")))
+ directories))))
+ (setq company-files--completion-cache
+ (cons key (append candidates children)))))
(all-completions prefix
(cdr company-files--completion-cache))))
@@ -88,7 +103,7 @@
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
- "`company-mode' completion back-end existing file names.
+ "`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
@@ -98,6 +113,8 @@ File paths with spaces are only supported inside strings."
(candidates (company-files--complete arg))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
+ (post-completion (when (company-files--trailing-slash-p arg)
+ (delete-char -1)))
(sorted t)
(no-cache t)))
diff --git a/packages/company/company-gtags.el
b/packages/company/company-gtags.el
index aaa22b9..5050783 100644
--- a/packages/company/company-gtags.el
+++ b/packages/company/company-gtags.el
@@ -1,4 +1,4 @@
-;;; company-gtags.el --- company-mode completion back-end for GNU Global
+;;; company-gtags.el --- company-mode completion backend for GNU Global
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@@ -26,10 +26,11 @@
;;; Code:
(require 'company)
+(require 'company-template)
(require 'cl-lib)
(defgroup company-gtags nil
- "Completion back-end for GNU Global."
+ "Completion backend for GNU Global."
:group 'company)
(defcustom company-gtags-executable
@@ -90,7 +91,7 @@ completion."
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
- "`company-mode' completion back-end for GNU Global."
+ "`company-mode' completion backend for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
diff --git a/packages/company/company-ispell.el
b/packages/company/company-ispell.el
index 4ce8dfc..c275bbe 100644
--- a/packages/company/company-ispell.el
+++ b/packages/company/company-ispell.el
@@ -1,6 +1,6 @@
-;;; company-ispell.el --- company-mode completion back-end using Ispell
+;;; company-ispell.el --- company-mode completion backend using Ispell
-;; Copyright (C) 2009-2011, 2013-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -30,7 +30,7 @@
(require 'ispell)
(defgroup company-ispell nil
- "Completion back-end using Ispell."
+ "Completion backend using Ispell."
:group 'company)
(defcustom company-ispell-dictionary nil
@@ -41,11 +41,16 @@ If nil, use `ispell-complete-word-dict'."
(defvar company-ispell-available 'unknown)
+(defalias 'company-ispell--lookup-words
+ (if (fboundp 'ispell-lookup-words)
+ 'ispell-lookup-words
+ 'lookup-words))
+
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
- (lookup-words "WHATEVER")
+ (company-ispell--lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company: ispell-look-command not found")
@@ -54,15 +59,16 @@ If nil, use `ispell-complete-word-dict'."
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
- "`company-mode' completion back-end using Ispell."
+ "`company-mode' completion backend using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates
- (let ((words (lookup-words arg (or company-ispell-dictionary
- ispell-complete-word-dict)))
+ (let ((words (company-ispell--lookup-words
+ arg
+ (or company-ispell-dictionary ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
;; Small optimization.
diff --git a/packages/company/company-keywords.el
b/packages/company/company-keywords.el
index f426c06..e59eaa2 100644
--- a/packages/company/company-keywords.el
+++ b/packages/company/company-keywords.el
@@ -1,6 +1,6 @@
-;;; company-keywords.el --- A company back-end for programming language
keywords
+;;; company-keywords.el --- A company backend for programming language keywords
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -35,13 +35,16 @@
(defvar company-keywords-alist
;; Please contribute corrections or additions.
`((c++-mode
- "asm" "auto" "bool" "break" "case" "catch" "char" "class" "const"
- "const_cast" "continue" "default" "delete" "do" "double" "dynamic_cast"
- "else" "enum" "explicit" "export" "extern" "false" "float" "for" "friend"
- "goto" "if" "inline" "int" "long" "mutable" "namespace" "new"
- "operator" "private" "protected" "public" "register" "reinterpret_cast"
- "return" "short" "signed" "sizeof" "static" "static_cast" "struct"
"switch"
- "template" "this" "throw" "true" "try" "typedef" "typeid" "typename"
+ "alignas" "alignof" "asm" "auto" "bool" "break" "case" "catch" "char"
+ "char16_t" "char32_t" "class" "const" "const_cast" "constexpr" "continue"
+ "decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum"
+ "explicit" "export" "extern" "false" "final" "float" "for" "friend"
+ "goto" "if" "inline" "int" "long" "mutable" "namespace" "new" "noexcept"
+ "nullptr" "operator" "override"
+ "private" "protected" "public" "register" "reinterpret_cast"
+ "return" "short" "signed" "sizeof" "static" "static_assert"
+ "static_cast" "struct" "switch" "template" "this" "thread_local"
+ "throw" "true" "try" "typedef" "typeid" "typename"
"union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while")
(c-mode
"auto" "break" "case" "char" "const" "continue" "default" "do"
@@ -207,17 +210,31 @@
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
"next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super"
"then" "true" "undef" "unless" "until" "when" "while" "yield")
+ (scala-mode
+ "abstract" "case" "catch" "class" "def" "do" "else" "extends" "false"
+ "final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match"
+ "new" "null" "object" "override" "package" "private" "protected"
+ "return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
+ "var" "while" "with" "yield")
+ (julia-mode
+ "abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
+ "end" "eval" "export" "false" "finally" "for" "function" "global" "if"
+ "ifelse" "immutable" "import" "importall" "in" "let" "macro" "module"
+ "otherwise" "quote" "return" "switch" "throw" "true" "try" "type"
+ "typealias" "using" "while"
+ )
;; aliases
(js2-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(cperl-mode . perl-mode)
- (jde-mode . java-mode))
+ (jde-mode . java-mode)
+ (ess-julia-mode . julia-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
- "`company-mode' back-end for programming language keywords."
+ "`company-mode' backend for programming language keywords."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-keywords))
diff --git a/packages/company/company-nxml.el b/packages/company/company-nxml.el
index 70e1c09..9c180e9 100644
--- a/packages/company/company-nxml.el
+++ b/packages/company/company-nxml.el
@@ -1,4 +1,4 @@
-;;; company-nxml.el --- company-mode completion back-end for nxml-mode
+;;; company-nxml.el --- company-mode completion backend for nxml-mode
;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
@@ -121,7 +121,7 @@
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `nxml-mode'."
+ "`company-mode' completion backend for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-nxml))
diff --git a/packages/company/company-oddmuse.el
b/packages/company/company-oddmuse.el
index aa30f2a..1b68950 100644
--- a/packages/company/company-oddmuse.el
+++ b/packages/company/company-oddmuse.el
@@ -1,4 +1,4 @@
-;;; company-oddmuse.el --- company-mode completion back-end for oddmuse-mode
+;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@@ -27,7 +27,7 @@
(require 'company)
(require 'cl-lib)
-(eval-when-compile (require 'yaooddmuse nil t))
+(eval-when-compile (require 'yaoddmuse nil t))
(eval-when-compile (require 'oddmuse nil t))
(defvar company-oddmuse-link-regexp
@@ -42,7 +42,7 @@
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
- "`company-mode' completion back-end for `oddmuse-mode'."
+ "`company-mode' completion backend for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-oddmuse))
diff --git a/packages/company/company-pysmell.el
b/packages/company/company-pysmell.el
deleted file mode 100644
index 8a69e76..0000000
--- a/packages/company/company-pysmell.el
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; company-pysmell.el --- company-mode completion back-end for pysmell.el
-
-;; Copyright (C) 2009-2011, 2013-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:
-;;
-;; The main problem with using this backend is installing Pysmell.
-;; I couldn't manage to do that. --Dmitry
-
-;;; Code:
-
-(if t (require 'pysmell)) ;Don't load during compilation.
-(require 'company)
-(require 'cl-lib)
-
-(defvar-local company-pysmell--available-p 'unknown)
-
-(defun company-pysmell--available-p ()
- (if (eq company-pysmell--available-p 'unknown)
- (setq company-pysmell--available-p
- (locate-dominating-file buffer-file-name "PYSMELLTAGS"))
- company-pysmell--available-p))
-
-(defun company-pysmell--grab-symbol ()
- (let ((symbol (company-grab-symbol)))
- (when symbol
- (cons symbol
- (save-excursion
- (let ((pos (point)))
- (goto-char (- (point) (length symbol)))
- (while (eq (char-before) ?.)
- (goto-char (1- (point)))
- (skip-syntax-backward "w_"))
- (- pos (point))))))))
-
-;;;###autoload
-(defun company-pysmell (command &optional arg &rest ignored)
- "`company-mode' completion back-end for pysmell.
-This requires pysmell.el and pymacs.el."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-pysmell))
- (prefix (and (derived-mode-p 'python-mode)
- buffer-file-name
- (not (company-in-string-or-comment))
- (company-pysmell--available-p)
- (company-pysmell--grab-symbol)))
- (candidates (delete "" (pysmell-get-all-completions)))))
-
-(provide 'company-pysmell)
-;;; company-pysmell.el ends here
diff --git a/packages/company/company-ropemacs.el
b/packages/company/company-ropemacs.el
deleted file mode 100644
index 4fc3813..0000000
--- a/packages/company/company-ropemacs.el
+++ /dev/null
@@ -1,72 +0,0 @@
-;;; company-ropemacs.el --- company-mode completion back-end for ropemacs
-
-;; Copyright (C) 2009-2011, 2013-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 'cl-lib)
-
-(defun company-ropemacs--grab-symbol ()
- (let ((symbol (company-grab-symbol)))
- (when symbol
- (cons symbol
- (save-excursion
- (let ((pos (point)))
- (goto-char (- (point) (length symbol)))
- (while (eq (char-before) ?.)
- (goto-char (1- (point)))
- (skip-syntax-backward "w_"))
- (- pos (point))))))))
-
-(defun company-ropemacs-doc-buffer (candidate)
- "Return buffer with docstring of CANDIDATE if it is available."
- (let ((doc (company-with-candidate-inserted candidate (rope-get-doc))))
- (when doc
- (company-doc-buffer doc))))
-
-(defun company-ropemacs-location (candidate)
- "Return location of CANDIDATE in cons form (FILE . LINE) if it is available."
- (let ((location (company-with-candidate-inserted candidate
- (rope-definition-location))))
- (when location
- (cons (elt location 0) (elt location 1)))))
-
-(defun company-ropemacs (command &optional arg &rest ignored)
- "`company-mode' completion back-end for ropemacs.
-
-Depends on third-party code: Pymacs (both Python and Emacs packages),
-rope, ropemacs and ropemode. Requires `ropemacs-mode' to be on."
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'company-ropemacs))
- (prefix (and (bound-and-true-p ropemacs-mode)
- (not (company-in-string-or-comment))
- (company-ropemacs--grab-symbol)))
- (candidates (mapcar (lambda (element) (concat arg element))
- (rope-completions)))
- (doc-buffer (company-ropemacs-doc-buffer arg))
- (location (company-ropemacs-location arg))))
-
-(provide 'company-ropemacs)
-;;; company-ropemacs.el ends here
diff --git a/packages/company/company-semantic.el
b/packages/company/company-semantic.el
index a1c7d16..8b13b72 100644
--- a/packages/company/company-semantic.el
+++ b/packages/company/company-semantic.el
@@ -1,6 +1,6 @@
-;;; company-semantic.el --- company-mode completion back-end using Semantic
+;;; company-semantic.el --- company-mode completion backend using Semantic
-;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -26,6 +26,7 @@
;;; Code:
(require 'company)
+(require 'company-template)
(require 'cl-lib)
(defvar semantic-idle-summary-function)
@@ -38,15 +39,30 @@
(declare-function semantic-tag-start "semantic/tag")
(declare-function semantic-tag-buffer "semantic/tag")
(declare-function semantic-active-p "semantic")
+(declare-function semantic-format-tag-prototype "semantic/format")
(defgroup company-semantic nil
- "Completion back-end using Semantic."
+ "Completion backend using Semantic."
:group 'company)
(defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc
"The function turning a semantic tag into doc information."
:type 'function)
+(defcustom company-semantic-begin-after-member-access t
+ "When non-nil, automatic completion will start whenever the current
+symbol is preceded by \".\", \"->\" or \"::\", ignoring
+`company-minimum-prefix-length'.
+
+If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
+and `c-electric-colon', for automatic completion right after \">\" and
+\":\".")
+
+(defcustom company-semantic-insert-arguments t
+ "When non-nil, insert function arguments as a template after completion."
+ :type 'boolean
+ :package-version '(company . "0.9.0"))
+
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
(defvar-local company-semantic--current-tags nil
@@ -89,7 +105,7 @@
(let ((completion-ignore-case nil)
(context (semantic-analyze-current-context)))
(setq company-semantic--current-tags
- (semantic-analyze-possible-completions context))
+ (semantic-analyze-possible-completions context 'no-unique))
(all-completions prefix company-semantic--current-tags))))
(defun company-semantic-completions-raw (prefix)
@@ -100,33 +116,21 @@
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic-annotation (argument tags)
- (let* ((tag (assoc argument tags))
+ (let* ((tag (assq argument tags))
(kind (when tag (elt tag 1))))
(cl-case kind
(function (let* ((prototype (semantic-format-tag-prototype tag nil nil))
(par-pos (string-match "(" prototype)))
(when par-pos (substring prototype par-pos)))))))
-(defun company-semantic--pre-prefix-length (prefix-length)
- "Sum up the length of all chained symbols before POS.
-Symbols are chained by \".\" or \"->\"."
- (save-excursion
- (let ((pos (point)))
- (goto-char (- (point) prefix-length))
- (while (looking-back "->\\|\\.")
- (goto-char (match-beginning 0))
- (skip-syntax-backward "w_"))
- (- pos (point)))))
-
-(defun company-semantic--grab ()
- "Grab the semantic prefix, but return everything before -> or . as length."
- (let ((symbol (company-grab-symbol)))
- (when symbol
- (cons symbol (company-semantic--pre-prefix-length (length symbol))))))
+(defun company-semantic--prefix ()
+ (if company-semantic-begin-after-member-access
+ (company-grab-symbol-cons "\\.\\|->\\|::" 2)
+ (company-grab-symbol)))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
- "`company-mode' completion back-end using CEDET Semantic."
+ "`company-mode' completion backend using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-semantic))
@@ -134,9 +138,9 @@ Symbols are chained by \".\" or \"->\"."
(semantic-active-p)
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
- (or (company-semantic--grab) 'stop)))
+ (or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
- (not (looking-back "->\\|\\.")))
+ (not (looking-back "->\\|\\." (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
@@ -147,10 +151,17 @@ Symbols are chained by \".\" or \"->\"."
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
+ (duplicates t)
(location (let ((tag (assoc arg company-semantic--current-tags)))
(when (buffer-live-p (semantic-tag-buffer tag))
(cons (semantic-tag-buffer tag)
- (semantic-tag-start tag)))))))
+ (semantic-tag-start tag)))))
+ (post-completion (let ((anno (company-semantic-annotation
+ arg company-semantic--current-tags)))
+ (when (and company-semantic-insert-arguments anno)
+ (insert anno)
+ (company-template-c-like-templatify (concat arg
anno)))
+ ))))
(provide 'company-semantic)
;;; company-semantic.el ends here
diff --git a/packages/company/company-template.el
b/packages/company/company-template.el
index 21ae011..053429d 100644
--- a/packages/company/company-template.el
+++ b/packages/company/company-template.el
@@ -1,6 +1,6 @@
-;;; company-template.el
+;;; company-template.el --- utility library for template expansion
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -93,16 +93,14 @@
(delq templ company-template--buffer-templates))
(delete-overlay templ))
-(defun company-template-add-field (templ pos text &optional display)
- "Add new field to template TEMPL at POS, inserting TEXT.
+(defun company-template-add-field (templ beg end &optional display)
+ "Add new field to template TEMPL spanning from BEG to END.
When DISPLAY is non-nil, set the respective property on the overlay.
Leave point at the end of the field."
(cl-assert templ)
- (goto-char pos)
- (insert text)
- (when (> (point) (overlay-end templ))
- (move-overlay templ (overlay-start templ) (point)))
- (let ((ov (make-overlay pos (+ pos (length text))))
+ (when (> end (overlay-end templ))
+ (move-overlay templ (overlay-start templ) end))
+ (let ((ov (make-overlay beg end))
(siblings (overlay-get templ 'company-template-fields)))
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'intangible t)
@@ -149,7 +147,6 @@ Leave point at the end of the field."
(defun company-template-c-like-templatify (call)
(let* ((end (point-marker))
(beg (- (point) (length call)))
- (cnt 0)
(templ (company-template-declare-template beg end))
paren-open paren-close)
(with-syntax-table (make-syntax-table (syntax-table))
@@ -167,29 +164,51 @@ Leave point at the end of the field."
(forward-char 1)
(backward-sexp)
(forward-char)
- (setq cnt (company-template--c-like-args templ angle-close
- cnt))))
+ (company-template--c-like-args templ angle-close)))
+ (when (looking-back "\\((\\*)\\)(" (line-beginning-position))
+ (delete-region (match-beginning 1) (match-end 1)))
(when paren-open
(goto-char paren-open)
- (company-template--c-like-args templ paren-close cnt)))
+ (company-template--c-like-args templ paren-close)))
(if (overlay-get templ 'company-template-fields)
(company-template-move-to-first templ)
(company-template-remove-template templ)
(goto-char end))))
-(defun company-template--c-like-args (templ end counter)
+(defun company-template--c-like-args (templ end)
(let ((last-pos (point)))
(while (re-search-forward "\\([^,]+\\),?" end 'move)
(when (zerop (car (parse-partial-sexp last-pos (point))))
- (let ((sig (buffer-substring-no-properties last-pos (match-end 1))))
- (save-excursion
- (company-template-add-field templ last-pos
- (format "arg%d" counter) sig)
- (delete-region (point) (+ (point) (length sig))))
- (skip-chars-forward " ")
- (setq last-pos (point))
- (cl-incf counter)))))
- counter)
+ (company-template-add-field templ last-pos (match-end 1))
+ (skip-chars-forward " ")
+ (setq last-pos (point))))))
+
+;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun company-template-objc-templatify (selector)
+ (let* ((end (point-marker))
+ (beg (- (point) (length selector) 1))
+ (templ (company-template-declare-template beg end))
+ (cnt 0))
+ (save-excursion
+ (goto-char beg)
+ (catch 'stop
+ (while (search-forward ":" end t)
+ (if (looking-at "\\(([^)]*)\\) ?")
+ (company-template-add-field templ (point) (match-end 1))
+ ;; Not sure which conditions this case manifests under, but
+ ;; apparently it did before, when I wrote the first test for this
+ ;; function. FIXME: Revisit it.
+ (company-template-add-field templ (point)
+ (progn
+ (insert (format "arg%d" cnt))
+ (point)))
+ (when (< (point) end)
+ (insert " "))
+ (cl-incf cnt))
+ (when (>= (point) end)
+ (throw 'stop t)))))
+ (company-template-move-to-first templ)))
(provide 'company-template)
;;; company-template.el ends here
diff --git a/packages/company/company-tempo.el
b/packages/company/company-tempo.el
index ac91988..cba42c3 100644
--- a/packages/company/company-tempo.el
+++ b/packages/company/company-tempo.el
@@ -1,6 +1,6 @@
-;;; company-tempo.el --- company-mode completion back-end for tempo
+;;; company-tempo.el --- company-mode completion backend for tempo
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
@@ -29,6 +29,15 @@
(require 'cl-lib)
(require 'tempo)
+(defgroup company-tempo nil
+ "Tempo completion backend."
+ :group 'company)
+
+(defcustom company-tempo-expand nil
+ "Whether to expand a tempo tag after completion."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t)))
+
(defsubst company-tempo-lookup (match)
(cdr (assoc match (tempo-build-collection))))
@@ -48,15 +57,14 @@
;;;###autoload
(defun company-tempo (command &optional arg &rest ignored)
- "`company-mode' completion back-end for tempo."
+ "`company-mode' completion backend for tempo."
(interactive (list 'interactive))
(cl-case command
- (interactive (company-begin-backend 'company-tempo
- 'company-tempo-insert))
+ (interactive (company-begin-backend 'company-tempo))
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
(candidates (all-completions arg (tempo-build-collection)))
(meta (company-tempo-meta arg))
- (require-match t)
+ (post-completion (when company-tempo-expand (company-tempo-insert arg)))
(sorted t)))
(provide 'company-tempo)
diff --git a/packages/company/company-xcode.el
b/packages/company/company-xcode.el
index c7a6f80..56da198 100644
--- a/packages/company/company-xcode.el
+++ b/packages/company/company-xcode.el
@@ -1,4 +1,4 @@
-;;; company-xcode.el --- company-mode completion back-end for Xcode projects
+;;; company-xcode.el --- company-mode completion backend for Xcode projects
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
@@ -29,7 +29,7 @@
(require 'cl-lib)
(defgroup company-xcode nil
- "Completion back-end for Xcode projects."
+ "Completion backend for Xcode projects."
:group 'company)
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
@@ -106,7 +106,7 @@ valid in most contexts."
company-xcode-tags))))))
;;;###autoload
(defun company-xcode (command &optional arg &rest ignored)
- "`company-mode' completion back-end for Xcode projects."
+ "`company-mode' completion backend for Xcode projects."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-xcode))
diff --git a/packages/company/company-yasnippet.el
b/packages/company/company-yasnippet.el
index f0a7c38..e5fded4 100644
--- a/packages/company/company-yasnippet.el
+++ b/packages/company/company-yasnippet.el
@@ -1,6 +1,6 @@
-;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet
+;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@@ -33,8 +33,47 @@
(declare-function yas-expand-snippet "yasnippet")
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
+(declare-function yas--warning "yasnippet")
+
+(defun company-yasnippet--key-prefixes ()
+ ;; Mostly copied from `yas--templates-for-key-at-point'.
+ (defvar yas-key-syntaxes)
+ (save-excursion
+ (let ((original (point))
+ (methods yas-key-syntaxes)
+ prefixes
+ method)
+ (while methods
+ (unless (eq method (car methods))
+ (goto-char original))
+ (setq method (car methods))
+ (cond ((stringp method)
+ (skip-syntax-backward method)
+ (setq methods (cdr methods)))
+ ((functionp method)
+ (unless (eq (funcall method original)
+ 'again)
+ (setq methods (cdr methods))))
+ (t
+ (setq methods (cdr methods))
+ (yas--warning "Invalid element `%s' in `yas-key-syntaxes'"
method)))
+ (let ((prefix (buffer-substring-no-properties (point) original)))
+ (unless (equal prefix (car prefixes))
+ (push prefix prefixes))))
+ prefixes)))
(defun company-yasnippet--candidates (prefix)
+ ;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
+ ;; matches, so the longest prefix with any matches should be the most useful.
+ (cl-loop with tables = (yas--get-snippet-tables)
+ for key-prefix in (company-yasnippet--key-prefixes)
+ ;; Only consider keys at least as long as the symbol at point.
+ when (>= (length key-prefix) (length prefix))
+ thereis (company-yasnippet--completions-for-prefix prefix
+ key-prefix
+ tables)))
+
+(defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
(cl-mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
@@ -43,28 +82,30 @@
(maphash
(lambda (key value)
(when (and (stringp key)
- (string-prefix-p prefix key))
+ (string-prefix-p key-prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
- 'yas-template template)
+ 'yas-template template
+ 'yas-prefix-offset (- (length key-prefix)
+ (length prefix)))
res))
value)))
keyhash))
res))
- (yas--get-snippet-tables)))
+ tables))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
- "`company-mode' back-end for `yasnippet'.
+ "`company-mode' backend for `yasnippet'.
-This back-end should be used with care, because as long as there are
-snippets defined for the current major mode, this back-end will always
-shadow back-ends that come after it. Recommended usages:
+This backend should be used with care, because as long as there are
+snippets defined for the current major mode, this backend will always
+shadow backends that come after it. Recommended usages:
-* In a buffer-local value of `company-backends', grouped with a back-end or
+* In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
@@ -72,7 +113,7 @@ shadow back-ends that come after it. Recommended usages:
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
-* After keyword `:with', grouped with other back-ends.
+* After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
@@ -93,10 +134,12 @@ shadow back-ends that come after it. Recommended usages:
(unless company-tooltip-align-annotations " -> ")
(get-text-property 0 'yas-annotation arg)))
(candidates (company-yasnippet--candidates arg))
+ (no-cache t)
(post-completion
- (let ((template (get-text-property 0 'yas-template arg)))
+ (let ((template (get-text-property 0 'yas-template arg))
+ (prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
(yas-expand-snippet (yas--template-content template)
- (- (point) (length arg))
+ (- (point) (length arg) prefix-offset)
(point)
(yas--template-expand-env template))))))
diff --git a/packages/company/company.el b/packages/company/company.el
index ce0b5a4..713a94f 100644
--- a/packages/company/company.el
+++ b/packages/company/company.el
@@ -1,11 +1,11 @@
;;; company.el --- Modular text completion framework -*- lexical-binding: t
-*-
-;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <address@hidden>
;; URL: http://company-mode.github.io/
-;; Version: 0.8.12
+;; Version: 0.9.0
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
@@ -26,37 +26,32 @@
;;; Commentary:
;;
-;; Company is a modular completion mechanism. Modules for retrieving
completion
-;; candidates are called back-ends, modules for displaying them are front-ends.
+;; Company is a modular completion framework. Modules for retrieving
completion
+;; candidates are called backends, modules for displaying them are frontends.
;;
-;; Company comes with many back-ends, e.g. `company-elisp'. These are
+;; Company comes with many backends, e.g. `company-etags'. These are
;; distributed in separate files and can be used individually.
;;
-;; Place company.el and the back-ends you want to use in a directory and add
the
-;; following to your .emacs:
-;; (add-to-list 'load-path "/path/to/company")
-;; (autoload 'company-mode "company" nil t)
+;; Enable `company-mode' in all buffers with M-x global-company-mode. For
+;; further information look at the documentation for `company-mode' (C-h f
+;; company-mode RET).
;;
-;; Enable company-mode with M-x company-mode. For further information look at
-;; the documentation for `company-mode' (C-h f company-mode RET)
-;;
-;; If you want to start a specific back-end, call it interactively or use
+;; If you want to start a specific backend, call it interactively or use
;; `company-begin-backend'. For example:
;; M-x company-abbrev will prompt for and insert an abbrev.
;;
-;; To write your own back-end, look at the documentation for
`company-backends'.
+;; To write your own backend, look at the documentation for `company-backends'.
;; Here is a simple example completing "foo":
;;
;; (defun company-my-backend (command &optional arg &rest ignored)
;; (pcase command
-;; (`prefix (when (looking-back "foo\\>")
-;; (match-string 0)))
+;; (`prefix (company-grab-symbol))
;; (`candidates (list "foobar" "foobaz" "foobarbaz"))
;; (`meta (format "This value is named %s" arg))))
;;
-;; Sometimes it is a good idea to mix several back-ends together, for example
to
-;; enrich gtags with dabbrev-code results (to emulate local variables).
-;; To do this, add a list with both back-ends as an element in
company-backends.
+;; Sometimes it is a good idea to mix several backends together, for example to
+;; enrich gtags with dabbrev-code results (to emulate local variables). To do
+;; this, add a list with both backends as an element in `company-backends'.
;;
;;; Change Log:
;;
@@ -66,6 +61,7 @@
(require 'cl-lib)
(require 'newcomment)
+(require 'pcase)
;; FIXME: Use `user-error'.
(add-to-list 'debug-ignored-errors "^.* frontend cannot be used twice$")
@@ -74,7 +70,7 @@
(add-to-list 'debug-ignored-errors "^Company not ")
(add-to-list 'debug-ignored-errors "^No candidate number ")
(add-to-list 'debug-ignored-errors "^Cannot complete at point$")
-(add-to-list 'debug-ignored-errors "^No other back-end$")
+(add-to-list 'debug-ignored-errors "^No other backend$")
;;; Compatibility
(eval-and-compile
@@ -104,8 +100,7 @@ buffer-local wherever it is set."
"Face used for the tooltip.")
(defface company-tooltip-selection
- '((default :inherit company-tooltip)
- (((class color) (min-colors 88) (background light))
+ '((((class color) (min-colors 88) (background light))
(:background "light blue"))
(((class color) (min-colors 88) (background dark))
(:background "orange1"))
@@ -121,28 +116,26 @@ buffer-local wherever it is set."
"Face used for the tooltip item under the mouse.")
(defface company-tooltip-common
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "darkred")
(((background dark))
:foreground "red"))
"Face used for the common completion in the tooltip.")
(defface company-tooltip-common-selection
- '((default :inherit company-tooltip-selection)
- (((background light))
- :foreground "darkred")
- (((background dark))
- :foreground "red"))
+ '((default :inherit company-tooltip-common))
"Face used for the selected common completion in the tooltip.")
(defface company-tooltip-annotation
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:foreground "firebrick4")
(((background dark))
:foreground "red4"))
- "Face used for the annotation in the tooltip.")
+ "Face used for the completion annotation in the tooltip.")
+
+(defface company-tooltip-annotation-selection
+ '((default :inherit company-tooltip-annotation))
+ "Face used for the selected completion annotation in the tooltip.")
(defface company-scrollbar-fg
'((((background light))
@@ -152,8 +145,7 @@ buffer-local wherever it is set."
"Face used for the tooltip scrollbar thumb.")
(defface company-scrollbar-bg
- '((default :inherit company-tooltip)
- (((background light))
+ '((((background light))
:background "wheat")
(((background dark))
:background "gold"))
@@ -161,7 +153,7 @@ buffer-local wherever it is set."
(defface company-preview
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit (company-tooltip-selection company-tooltip))
(((background dark))
:background "blue4"
:foreground "wheat"))
@@ -169,7 +161,7 @@ buffer-local wherever it is set."
(defface company-preview-common
'((((background light))
- :inherit company-tooltip-selection)
+ :inherit company-tooltip-common-selection)
(((background dark))
:inherit company-preview
:foreground "red"))
@@ -194,9 +186,13 @@ buffer-local wherever it is set."
(defun company-frontends-set (variable value)
;; Uniquify.
(let ((value (delete-dups (copy-sequence value))))
- (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
- (memq 'company-pseudo-tooltip-frontend value)
- (error "Pseudo tooltip frontend cannot be used twice"))
+ (and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
+ (memq 'company-pseudo-tooltip-frontend value))
+ (and (memq
'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
+ (memq 'company-pseudo-tooltip-frontend value))
+ (and (memq
'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
+ (memq 'company-pseudo-tooltip-unless-just-one-frontend
value)))
+ (error "Pseudo tooltip frontend cannot be used more than once"))
(and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-frontend value)
(error "Preview frontend cannot be used twice"))
@@ -212,8 +208,8 @@ buffer-local wherever it is set."
(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
company-preview-if-just-one-frontend
company-echo-metadata-frontend)
- "The list of active front-ends (visualizations).
-Each front-end is a function that takes one argument. It is called with
+ "The list of active frontends (visualizations).
+Each frontend is a function that takes one argument. It is called with
one of the following arguments:
`show': When the visualization should start.
@@ -241,6 +237,8 @@ The visualized data is stored in `company-prefix',
`company-candidates',
company-pseudo-tooltip-frontend)
(const :tag "pseudo tooltip, multiple only"
company-pseudo-tooltip-unless-just-one-frontend)
+ (const :tag "pseudo tooltip, multiple only, delayed"
+
company-pseudo-tooltip-unless-just-one-frontend-with-delay)
(const :tag "preview" company-preview-frontend)
(const :tag "preview, unique only"
company-preview-if-just-one-frontend)
@@ -300,8 +298,6 @@ This doesn't include the margins and the scroll bar."
(company-keywords . "Programming language keywords")
(company-nxml . "nxml")
(company-oddmuse . "Oddmuse")
- (company-pysmell . "PySmell")
- (company-ropemacs . "ropemacs")
(company-semantic . "Semantic")
(company-tempo . "Tempo templates")
(company-xcode . "Xcode")))
@@ -315,37 +311,39 @@ This doesn't include the margins and the scroll bar."
(assq backend company-safe-backends))
(cl-return t))))))
-(defcustom company-backends `(,@(unless (version< "24.3.50" emacs-version)
+(defcustom company-backends `(,@(unless (version< "24.3.51" emacs-version)
(list 'company-elisp))
company-bbdb
company-nxml company-css
company-eclim company-semantic company-clang
- company-xcode company-ropemacs company-cmake
+ company-xcode company-cmake
company-capf
+ company-files
(company-dabbrev-code company-gtags company-etags
company-keywords)
- company-oddmuse company-files company-dabbrev)
- "The list of active back-ends (completion engines).
+ company-oddmuse company-dabbrev)
+ "The list of active backends (completion engines).
-Only one back-end is used at a time. The choice depends on the order of
+Only one backend is used at a time. The choice depends on the order of
the items in this list, and on the values they return in response to the
-`prefix' command (see below). But a back-end can also be a \"grouped\"
+`prefix' command (see below). But a backend can also be a \"grouped\"
one (see below).
-`company-begin-backend' can be used to start a specific back-end,
-`company-other-backend' will skip to the next matching back-end in the list.
+`company-begin-backend' can be used to start a specific backend,
+`company-other-backend' will skip to the next matching backend in the list.
-Each back-end is a function that takes a variable number of arguments.
-The first argument is the command requested from the back-end. It is one
+Each backend is a function that takes a variable number of arguments.
+The first argument is the command requested from the backend. It is one
of the following:
-`prefix': The back-end should return the text to be completed. It must be
+`prefix': The backend should return the text to be completed. It must be
text immediately before point. Returning nil from this command passes
-control to the next back-end. The function should return `stop' if it
+control to the next backend. The function should return `stop' if it
should complete but cannot (e.g. if it is in the middle of a string).
-Instead of a string, the back-end may return a cons where car is the prefix
-and cdr is used in `company-minimum-prefix-length' test. It must be either
-number or t, and in the latter case the test automatically succeeds.
+Instead of a string, the backend may return a cons (PREFIX . LENGTH)
+where LENGTH is a number used in place of PREFIX's length when
+comparing against `company-minimum-prefix-length'. LENGTH can also
+be just t, and in the latter case the test automatically succeeds.
`candidates': The second argument is the prefix to be completed. The
return value should be a list of candidates that match the prefix.
@@ -355,7 +353,8 @@ prefix, but match it in some backend-defined way).
Backends that use this
feature must disable cache (return t to `no-cache') and might also want to
respond to `match'.
-Optional commands:
+Optional commands
+=================
`sorted': Return t here to indicate that the candidates are sorted and will
not need to be sorted again.
@@ -364,16 +363,23 @@ not need to be sorted again.
from the list.
`no-cache': Usually company doesn't ask for candidates again as completion
-progresses, unless the back-end returns t for this command. The second
+progresses, unless the backend returns t for this command. The second
argument is the latest prefix.
+`ignore-case': Return t here if the backend returns case-insensitive
+matches. This value is used to determine the longest common prefix (as
+used in `company-complete-common'), and to filter completions when fetching
+them from cache.
+
`meta': The second argument is a completion candidate. Return a (short)
documentation string for it.
`doc-buffer': The second argument is a completion candidate. Return a
-buffer with documentation for it. Preferably use `company-doc-buffer',
+buffer with documentation for it. Preferably use `company-doc-buffer'. If
+not all buffer contents pertain to this candidate, return a cons of buffer
+and window start position.
-`location': The second argument is a completion candidate. Return the cons
+`location': The second argument is a completion candidate. Return a cons
of buffer and buffer location, or of file and line number where the
completion candidate was defined.
@@ -390,56 +396,62 @@ will be used when rendering the popup. This command only
makes sense for
backends that provide non-prefix completion.
`require-match': If this returns t, the user is not allowed to enter
-anything not offered as a candidate. Use with care! The default value nil
-gives the user that choice with `company-require-match'. Return value
-`never' overrides that option the other way around.
+anything not offered as a candidate. Please don't use that value in normal
+backends. The default value nil gives the user that choice with
+`company-require-match'. Return value `never' overrides that option the
+other way around.
-`init': Called once for each buffer. The back-end can check for external
+`init': Called once for each buffer. The backend can check for external
programs and files and load any required libraries. Raising an error here
-will show up in message log once, and the back-end will not be used for
+will show up in message log once, and the backend will not be used for
completion.
`post-completion': Called after a completion candidate has been inserted
into the buffer. The second argument is the candidate. Can be used to
modify it, e.g. to expand a snippet.
-The back-end should return nil for all commands it does not support or
+The backend should return nil for all commands it does not support or
does not know about. It should also be callable interactively and use
`company-begin-backend' to start itself in that case.
-Grouped back-ends:
+Grouped backends
+================
-An element of `company-backends' can also itself be a list of back-ends,
-then it's considered to be a \"grouped\" back-end.
+An element of `company-backends' can also be a list of backends. The
+completions from backends in such groups are merged, but only from those
+backends which return the same `prefix'.
-When possible, commands taking a candidate as an argument are dispatched to
-the back-end it came from. In other cases, the first non-nil value among
-all the back-ends is returned.
+If a backend command takes a candidate as an argument (e.g. `meta'), the
+call is dispatched to the backend the candidate came from. In other
+cases (except for `duplicates' and `sorted'), the first non-nil value among
+all the backends is returned.
-The latter is the case for the `prefix' command. But if the group contains
-the keyword `:with', the back-ends after it are ignored for this command.
+The group can also contain keywords. Currently, `:with' and `:separate'
+keywords are defined. If the group contains keyword `:with', the backends
+listed after this keyword are ignored for the purpose of the `prefix'
+command. If the group contains keyword `:separate', the candidates that
+come from different backends are sorted separately in the combined list.
-The completions from back-ends in a group are merged (but only from those
-that return the same `prefix').
-
-Asynchronous back-ends:
+Asynchronous backends
+=====================
The return value of each command can also be a cons (:async . FETCHER)
where FETCHER is a function of one argument, CALLBACK. When the data
arrives, FETCHER must call CALLBACK and pass it the appropriate return
-value, as described above.
+value, as described above. That call must happen in the same buffer as
+where completion was initiated.
True asynchronous operation is only supported for command `candidates', and
only during idle completion. Other commands will block the user interface,
-even if the back-end uses the asynchronous calling convention."
+even if the backend uses the asynchronous calling convention."
:type `(repeat
(choice
- :tag "Back-end"
+ :tag "backend"
,@(mapcar (lambda (b) `(const :tag ,(cdr b) ,(car b)))
company-safe-backends)
(symbol :tag "User defined")
- (repeat :tag "Merged Back-ends"
- (choice :tag "Back-end"
+ (repeat :tag "Merged backends"
+ (choice :tag "backend"
,@(mapcar (lambda (b)
`(const :tag ,(cdr b) ,(car b)))
company-safe-backends)
@@ -457,8 +469,10 @@ without duplicates."
:type '(choice
(const :tag "None" nil)
(const :tag "Sort by occurrence" (company-sort-by-occurrence))
- (const :tag "Sort by back-end importance"
+ (const :tag "Sort by backend importance"
(company-sort-by-backend-importance))
+ (const :tag "Prefer case sensitive prefix"
+ (company-sort-prefer-same-case-prefix))
(repeat :tag "User defined" (function))))
(defcustom company-completion-started-hook nil
@@ -478,7 +492,7 @@ aborted manually."
The hook is called with the selected candidate as an argument.
If you indend to use it to post-process candidates from a specific
-back-end, consider using the `post-completion' command instead."
+backend, consider using the `post-completion' command instead."
:type 'hook)
(defcustom company-minimum-prefix-length 3
@@ -496,7 +510,7 @@ prefix it was started from."
"If enabled, disallow non-matching input.
This can be a function do determine if a match is required.
-This can be overridden by the back-end, if it returns t or `never' to
+This can be overridden by the backend, if it returns t or `never' to
`require-match'. `company-auto-complete' also takes precedence over this."
:type '(choice (const :tag "Off" nil)
(function :tag "Predicate function")
@@ -551,6 +565,13 @@ happens. The value of nil means no idle completion."
(const :tag "immediate (0)" 0)
(number :tag "seconds")))
+(defcustom company-tooltip-idle-delay .5
+ "The idle delay in seconds until tooltip is shown when using
+`company-pseudo-tooltip-unless-just-one-frontend-with-delay'."
+ :type '(choice (const :tag "never (nil)" nil)
+ (const :tag "immediate (0)" 0)
+ (number :tag "seconds")))
+
(defcustom company-begin-commands '(self-insert-command
org-self-insert-command
orgtbl-self-insert-command
@@ -651,7 +672,7 @@ asynchronous call into synchronous.")
(error
(put backend 'company-init 'failed)
(unless (memq backend company--disabled-backends)
- (message "Company back-end '%s' could not be initialized:\n%s"
+ (message "Company backend '%s' could not be initialized:\n%s"
backend (error-message-string err)))
(cl-pushnew backend company--disabled-backends)
nil)))
@@ -668,7 +689,7 @@ asynchronous call into synchronous.")
:package-version '(company . "0.8.10"))
(defvar company-lighter '(" "
- (company-backend
+ (company-candidates
(:eval
(if (consp company-backend)
(company--group-lighter (nth company-selection
@@ -699,9 +720,12 @@ Completions can be searched with
`company-search-candidates' or
inactive, as well.
The completion data is retrieved using `company-backends' and displayed
-using `company-frontends'. If you want to start a specific back-end, call
+using `company-frontends'. If you want to start a specific backend, call
it interactively or use `company-begin-backend'.
+By default, the completions list is sorted alphabetically, unless the
+backend chooses otherwise, or `company-transformers' changes it later.
+
regular keymap (`company-mode-map'):
\\{company-mode-map}
@@ -797,7 +821,9 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(let ((col (car (posn-col-row posn)))
;; `posn-col-row' doesn't work well with lines of different height.
;; `posn-actual-col-row' doesn't handle multiple-width characters.
- (row (cdr (posn-actual-col-row posn))))
+ (row (cdr (or (posn-actual-col-row posn)
+ ;; When position is non-visible for some reason.
+ (posn-col-row posn)))))
(when (and header-line-format (version< emacs-version "24.3.93.3"))
;; http://debbugs.gnu.org/18384
(cl-decf row))
@@ -818,9 +844,16 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(or (match-string-no-properties (or expression 0)) "")))
(defun company-grab-line (regexp &optional expression)
- (company-grab regexp expression (point-at-bol)))
+ "Return a match string for REGEXP if it matches text before point.
+If EXPRESSION is non-nil, return the match string for the respective
+parenthesized expression in REGEXP.
+Matching is limited to the current line."
+ (let ((inhibit-field-text-motion t))
+ (company-grab regexp expression (point-at-bol))))
(defun company-grab-symbol ()
+ "If point is at the end of a symbol, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
(if (looking-at "\\_>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "w_")
(point)))
@@ -828,6 +861,8 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
"")))
(defun company-grab-word ()
+ "If point is at the end of a word, return it.
+Otherwise, if point is not inside a symbol, return an empty string."
(if (looking-at "\\>")
(buffer-substring (point) (save-excursion (skip-syntax-backward "w")
(point)))
@@ -835,6 +870,9 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
"")))
(defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
+ "Return a string SYMBOL or a cons (SYMBOL . t).
+SYMBOL is as returned by `company-grab-symbol'. If the text before point
+matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(let ((symbol (company-grab-symbol)))
(when symbol
(save-excursion
@@ -846,6 +884,7 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
symbol)))))
(defun company-in-string-or-comment ()
+ "Return non-nil if point is within a string or comment."
(let ((ppss (syntax-ppss)))
(or (car (setq ppss (nthcdr 3 ppss)))
(car (setq ppss (cdr ppss)))
@@ -864,7 +903,7 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(lambda (result) (setq res result)))
(while (eq res 'trash)
(if (> (- (time-to-seconds) start) company-async-timeout)
- (error "Company: Back-end %s async timeout with args %s"
+ (error "Company: backend %s async timeout with args %s"
backend args)
(sleep-for company-async-wait)))
res))))
@@ -874,23 +913,26 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(if (functionp company-backend)
(apply company-backend args)
(apply #'company--multi-backend-adapter company-backend args))
- (error (error "Company: Back-end %s error \"%s\" with args %s"
+ (error (error "Company: backend %s error \"%s\" with args %s"
company-backend (error-message-string err) args))))
(defun company--multi-backend-adapter (backends command &rest args)
(let ((backends (cl-loop for b in backends
when (not (and (symbolp b)
(eq 'failed (get b 'company-init))))
- collect b)))
- (setq backends
- (if (eq command 'prefix)
- (butlast backends (length (member :with backends)))
- (delq :with backends)))
+ collect b))
+ (separate (memq :separate backends)))
+
+ (when (eq command 'prefix)
+ (setq backends (butlast backends (length (member :with backends)))))
+
+ (setq backends (cl-delete-if #'keywordp backends))
+
(pcase command
(`candidates
- (company--multi-backend-adapter-candidates backends (car args)))
- (`sorted nil)
- (`duplicates t)
+ (company--multi-backend-adapter-candidates backends (car args)
separate))
+ (`sorted separate)
+ (`duplicates (not separate))
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(cl-dolist (backend backends)
@@ -904,26 +946,35 @@ means that `company-mode' is always turned on except in
`message-mode' buffers."
(car backends))))
(apply backend command args))))))))
-(defun company--multi-backend-adapter-candidates (backends prefix)
- (let ((pairs (cl-loop for backend in (cdr backends)
+(defun company--multi-backend-adapter-candidates (backends prefix separate)
+ (let ((pairs (cl-loop for backend in backends
when (equal (company--prefix-str
(funcall backend 'prefix))
prefix)
collect (cons (funcall backend 'candidates prefix)
- (let ((b backend))
- (lambda (candidates)
- (mapcar
- (lambda (str)
- (propertize str 'company-backend
b))
- candidates)))))))
- (when (equal (company--prefix-str (funcall (car backends) 'prefix)) prefix)
- ;; Small perf optimization: don't tag the candidates received
- ;; from the first backend in the group.
- (push (cons (funcall (car backends) 'candidates prefix)
- 'identity)
- pairs))
+ (company--multi-candidates-mapper
+ backend
+ separate
+ ;; Small perf optimization: don't tag
the
+ ;; candidates received from the first
+ ;; backend in the group.
+ (not (eq backend (car backends))))))))
(company--merge-async pairs (lambda (values) (apply #'append values)))))
+(defun company--multi-candidates-mapper (backend separate tag)
+ (lambda (candidates)
+ (when separate
+ (let ((company-backend backend))
+ (setq candidates
+ (company--preprocess-candidates candidates))))
+ (when tag
+ (setq candidates
+ (mapcar
+ (lambda (str)
+ (propertize str 'company-backend backend))
+ candidates)))
+ candidates))
+
(defun company--merge-async (pairs merger)
(let ((async (cl-loop for pair in pairs
thereis
@@ -990,22 +1041,24 @@ Controlled by `company-auto-complete'.")
(defvar-local company-point nil)
(defvar company-timer nil)
+(defvar company-tooltip-timer nil)
(defsubst company-strip-prefix (str)
(substring str (length company-prefix)))
(defun company--insert-candidate (candidate)
- (setq candidate (substring-no-properties candidate))
- ;; XXX: Return value we check here is subject to change.
- (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
- (insert (company-strip-prefix candidate))
- (unless (equal company-prefix candidate)
- (delete-region (- (point) (length company-prefix)) (point))
- (insert candidate))))
+ (when (> (length candidate) 0)
+ (setq candidate (substring-no-properties candidate))
+ ;; XXX: Return value we check here is subject to change.
+ (if (eq (company-call-backend 'ignore-case) 'keep-prefix)
+ (insert (company-strip-prefix candidate))
+ (unless (equal company-prefix candidate)
+ (delete-region (- (point) (length company-prefix)) (point))
+ (insert candidate)))))
(defmacro company-with-candidate-inserted (candidate &rest body)
"Evaluate BODY with CANDIDATE temporarily inserted.
-This is a tool for back-ends that need candidates inserted before they
+This is a tool for backends that need candidates inserted before they
can retrieve meta-data for them."
(declare (indent 1))
`(let ((inhibit-modification-hooks t)
@@ -1053,7 +1106,7 @@ can retrieve meta-data for them."
(dolist (frontend company-frontends)
(condition-case-unless-debug err
(funcall frontend command)
- (error (error "Company: Front-end %s error \"%s\" on command %s"
+ (error (error "Company: frontend %s error \"%s\" on command %s"
frontend (error-message-string err) command)))))
(defun company-set-selection (selection &optional force-update)
@@ -1068,7 +1121,8 @@ can retrieve meta-data for them."
(defun company--group-lighter (candidate base)
(let ((backend (or (get-text-property 0 'company-backend candidate)
- (car company-backend))))
+ (cl-some (lambda (x) (and (not (keywordp x)) x))
+ company-backend))))
(when (and backend (symbolp backend))
(let ((name (replace-regexp-in-string "company-\\|-company" ""
(symbol-name backend))))
@@ -1138,10 +1192,11 @@ can retrieve meta-data for them."
t))))
(defun company--fetch-candidates (prefix)
- (let ((c (if company--manual-action
- (company-call-backend 'candidates prefix)
- (company-call-backend-raw 'candidates prefix)))
- res)
+ (let* ((non-essential (not (company-explicit-action-p)))
+ (c (if company--manual-action
+ (company-call-backend 'candidates prefix)
+ (company-call-backend-raw 'candidates prefix)))
+ res)
(if (not (eq (car c) :async))
c
(let ((buf (current-buffer))
@@ -1160,7 +1215,11 @@ can retrieve meta-data for them."
company-candidates-cache
(list (cons prefix
(company--preprocess-candidates candidates))))
- (company-idle-begin buf win tick pt)))))
+ (unwind-protect
+ (company-idle-begin buf win tick pt)
+ (unless company-candidates
+ (setq company-backend nil
+ company-candidates-cache nil)))))))
;; FIXME: Relying on the fact that the callers
;; will interpret nil as "do nothing" is shaky.
;; A throw-catch would be one possible improvement.
@@ -1168,6 +1227,7 @@ can retrieve meta-data for them."
(progn (setq res 'done) nil)))))
(defun company--preprocess-candidates (candidates)
+ (cl-assert (cl-every #'stringp candidates))
(unless (company-call-backend 'sorted)
(setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates)
@@ -1281,8 +1341,8 @@ Keywords and function definition names are ignored."
(defun company-sort-by-backend-importance (candidates)
"Sort CANDIDATES as two priority groups.
If `company-backend' is a function, do nothing. If it's a list, move
-candidates from back-ends before keyword `:with' to the front. Candidates
-from the rest of the back-ends in the group, if any, will be left at the end."
+candidates from backends before keyword `:with' to the front. Candidates
+from the rest of the backends in the group, if any, will be left at the end."
(if (functionp company-backend)
candidates
(let ((low-priority (cdr (memq :with company-backend))))
@@ -1296,6 +1356,16 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(let ((b1 (get-text-property 0 'company-backend c1)))
(or (not b1) (not (memq b1 low-priority)))))))))))
+(defun company-sort-prefer-same-case-prefix (candidates)
+ "Prefer CANDIDATES with the exact same prefix.
+If a backend returns case insensitive matches, candidates with the an exact
+prefix match (same case) will be prioritized."
+ (cl-loop for candidate in candidates
+ if (string-prefix-p company-prefix candidate)
+ collect candidate into same-case
+ else collect candidate into other-case
+ finally return (append same-case other-case)))
+
(defun company-idle-begin (buf win tick pos)
(and (eq buf (current-buffer))
(eq win (selected-window))
@@ -1320,6 +1390,7 @@ from the rest of the back-ends in the group, if any, will
be left at the end."
(company-cancel))
(quit (company-cancel))))))
+;;;###autoload
(defun company-manual-begin ()
(interactive)
(company-assert-enabled)
@@ -1346,7 +1417,7 @@ from the rest of the back-ends in the group, if any, will
be left at the end."
(when (ignore-errors (company-begin-backend backend))
(cl-return t))))
(unless company-candidates
- (error "No other back-end")))
+ (error "No other backend")))
(defun company-require-match-p ()
(let ((backend-value (company-call-backend 'require-match)))
@@ -1461,10 +1532,14 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(setq company-prefix (company--prefix-str prefix)
company-backend backend
c (company-calculate-candidates company-prefix))
- ;; t means complete/unique. We don't start, so no hooks.
(if (not (consp c))
- (when company--manual-action
- (message "No completion found"))
+ (progn
+ (when company--manual-action
+ (message "No completion found"))
+ (when (eq c t)
+ ;; t means complete/unique.
+ ;; Run the hooks anyway, to e.g. clear the cache.
+ (company-cancel 'unique)))
(when company--manual-action
(setq company--manual-prefix prefix))
(company-update-candidates c)
@@ -1485,14 +1560,8 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(company-call-frontends 'update)))
(defun company-cancel (&optional result)
- (unwind-protect
- (when company-prefix
- (if (stringp result)
- (progn
- (company-call-backend 'pre-completion result)
- (run-hook-with-args 'company-completion-finished-hook result)
- (company-call-backend 'post-completion result))
- (run-hook-with-args 'company-completion-cancelled-hook result)))
+ (let ((prefix company-prefix)
+ (backend company-backend))
(setq company-backend nil
company-prefix nil
company-candidates nil
@@ -1508,9 +1577,19 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
company-point nil)
(when company-timer
(cancel-timer company-timer))
+ (company-echo-cancel t)
(company-search-mode 0)
(company-call-frontends 'hide)
- (company-enable-overriding-keymap nil))
+ (company-enable-overriding-keymap nil)
+ (when prefix
+ ;; FIXME: RESULT can also be e.g. `unique'. We should call
+ ;; `company-completion-finished-hook' in that case, with right argument.
+ (if (stringp result)
+ (let ((company-backend backend))
+ (company-call-backend 'pre-completion result)
+ (run-hook-with-args 'company-completion-finished-hook result)
+ (company-call-backend 'post-completion result))
+ (run-hook-with-args 'company-completion-cancelled-hook result))))
;; Make return value explicit.
nil)
@@ -1526,6 +1605,7 @@ from the rest of the back-ends in the group, if any, will
be left at the end."
(and (symbolp command) (get command 'company-keep)))
(defun company-pre-command ()
+ (company--electric-restore-window-configuration)
(unless (company-keep this-command)
(condition-case-unless-debug err
(when company-candidates
@@ -1538,10 +1618,12 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(when company-timer
(cancel-timer company-timer)
(setq company-timer nil))
+ (company-echo-cancel t)
(company-uninstall-map))
(defun company-post-command ()
- (when (null this-command)
+ (when (and company-candidates
+ (null this-command))
;; Happens when the user presses `C-g' while inside
;; `flyspell-post-command-hook', for example.
;; Or any other `post-command-hook' function that can call `sit-for',
@@ -1557,6 +1639,7 @@ from the rest of the back-ends in the group, if any, will
be left at the end."
(if company-candidates
(company-call-frontends 'post-command)
(and (numberp company-idle-delay)
+ (not defining-kbd-macro)
(company--should-begin)
(setq company-timer
(run-with-timer company-idle-delay nil
@@ -1586,6 +1669,19 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
;;; search
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defcustom company-search-regexp-function #'regexp-quote
+ "Function to construct the search regexp from input.
+It's called with one argument, the current search input. It must return
+either a regexp without groups, or one where groups don't intersect and
+each one wraps a part of the input string."
+ :type '(choice
+ (const :tag "Exact match" regexp-quote)
+ (const :tag "Words separated with spaces"
company-search-words-regexp)
+ (const :tag "Words separated with spaces, in any order"
+ company-search-words-in-any-order-regexp)
+ (const :tag "All characters in given order, with anything in between"
+ company-search-flex-regexp)))
+
(defvar-local company-search-string "")
(defvar company-search-lighter '(" "
@@ -1601,11 +1697,42 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(defvar-local company--search-old-changed nil)
+(defun company-search-words-regexp (input)
+ (mapconcat (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t) ".*"))
+
+(defun company-search-words-in-any-order-regexp (input)
+ (let* ((words (mapcar (lambda (word) (format "\\(%s\\)" (regexp-quote word)))
+ (split-string input " +" t)))
+ (permutations (company--permutations words)))
+ (mapconcat (lambda (words)
+ (mapconcat #'identity words ".*"))
+ permutations
+ "\\|")))
+
+(defun company-search-flex-regexp (input)
+ (if (zerop (length input))
+ ""
+ (concat (regexp-quote (string (aref input 0)))
+ (mapconcat (lambda (c)
+ (concat "[^" (string c) "]*"
+ (regexp-quote (string c))))
+ (substring input 1) ""))))
+
+(defun company--permutations (lst)
+ (if (not lst)
+ '(nil)
+ (cl-mapcan
+ (lambda (e)
+ (mapcar (lambda (perm) (cons e perm))
+ (company--permutations (cl-remove e lst :count 1))))
+ lst)))
+
(defun company--search (text lines)
- (let ((quoted (regexp-quote text))
+ (let ((re (funcall company-search-regexp-function text))
(i 0))
(cl-dolist (line lines)
- (when (string-match quoted line (length company-prefix))
+ (when (string-match-p re line (length company-prefix))
(cl-return i))
(cl-incf i))))
@@ -1623,11 +1750,12 @@ from the rest of the back-ends in the group, if any,
will be left at the end."
(company--search-update-predicate ss))
(company--search-update-string ss)))
-(defun company--search-update-predicate (&optional ss)
- (let* ((company-candidates-predicate
- (and (not (string= ss ""))
+(defun company--search-update-predicate (ss)
+ (let* ((re (funcall company-search-regexp-function ss))
+ (company-candidates-predicate
+ (and (not (string= re ""))
company-search-filtering
- (lambda (candidate) (string-match ss candidate))))
+ (lambda (candidate) (string-match re candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
@@ -1782,6 +1910,9 @@ Don't start this directly, use
`company-search-candidates' or
Regular characters are appended to the search string.
+Customize `company-search-regexp-function' to change how the input
+is interpreted when searching.
+
The command `company-search-toggle-filtering'
(\\[company-search-toggle-filtering])
uses the search string to filter the completion candidates."
(interactive)
@@ -1805,33 +1936,40 @@ followed by `company-search-toggle-filtering'."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun company-select-next ()
- "Select the next candidate in the list."
- (interactive)
- (when (company-manual-begin)
- (company-set-selection (1+ company-selection))))
+(defun company-select-next (&optional arg)
+ "Select the next candidate in the list.
-(defun company-select-previous ()
- "Select the previous candidate in the list."
- (interactive)
+With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
- (company-set-selection (1- company-selection))))
+ (company-set-selection (+ (or arg 1) company-selection))))
+
+(defun company-select-previous (&optional arg)
+ "Select the previous candidate in the list.
+
+With ARG, move by that many elements."
+ (interactive "p")
+ (company-select-next (if arg (- arg) -1)))
-(defun company-select-next-or-abort ()
+(defun company-select-next-or-abort (&optional arg)
"Select the next candidate if more than one, else abort
-and invoke the normal binding."
- (interactive)
+and invoke the normal binding.
+
+With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-next)
+ (company-select-next arg)
(company-abort)
(company--unread-last-input)))
-(defun company-select-previous-or-abort ()
+(defun company-select-previous-or-abort (&optional arg)
"Select the previous candidate if more than one, else abort
-and invoke the normal binding."
- (interactive)
+and invoke the normal binding.
+
+With ARG, move by that many elements."
+ (interactive "p")
(if (> company-candidates-length 1)
- (company-select-previous)
+ (company-select-previous arg)
(company-abort)
(company--unread-last-input)))
@@ -1916,19 +2054,45 @@ and invoke the normal binding."
(if (and (not (cdr company-candidates))
(equal company-common (car company-candidates)))
(company-complete-selection)
- (when company-common
- (company--insert-candidate company-common)))))
+ (company--insert-candidate company-common))))
-(defun company-complete-common-or-cycle ()
- "Insert the common part of all candidates, or select the next one."
- (interactive)
+(defun company-complete-common-or-cycle (&optional arg)
+ "Insert the common part of all candidates, or select the next one.
+
+With ARG, move by that many elements."
+ (interactive "p")
(when (company-manual-begin)
(let ((tick (buffer-chars-modified-tick)))
(call-interactively 'company-complete-common)
(when (eq tick (buffer-chars-modified-tick))
- (let ((company-selection-wrap-around t))
+ (let ((company-selection-wrap-around t)
+ (current-prefix-arg arg))
(call-interactively 'company-select-next))))))
+(defun company-indent-or-complete-common ()
+ "Indent the current line or region, or complete the common part."
+ (interactive)
+ (cond
+ ((use-region-p)
+ (indent-region (region-beginning) (region-end)))
+ ((let ((old-point (point))
+ (old-tick (buffer-chars-modified-tick))
+ (tab-always-indent t))
+ (call-interactively #'indent-for-tab-command)
+ (when (and (eq old-point (point))
+ (eq old-tick (buffer-chars-modified-tick)))
+ (company-complete-common))))))
+
+(defun company-select-next-if-tooltip-visible-or-complete-selection ()
+ "Insert selection if appropriate, or select the next candidate.
+Insert selection if only preview is showing or only one candidate,
+otherwise select the next candidate."
+ (interactive)
+ (if (and (company-tooltip-visible-p) (> company-candidates-length 1))
+ (call-interactively 'company-select-next)
+ (call-interactively 'company-complete-selection)))
+
+;;;###autoload
(defun company-complete ()
"Insert the common part of all candidates or the current selection.
The first time this is called, the common part is inserted, the second
@@ -1944,7 +2108,7 @@ inserted."
(defun company-complete-number (n)
"Insert the Nth candidate visible in the tooltip.
-To show the number next to the candidates in some back-ends, enable
+To show the number next to the candidates in some backends, enable
`company-show-numbers'. When called interactively, uses the last typed
character, stripping the modifiers. That character must be a digit."
(interactive
@@ -2014,25 +2178,30 @@ character, stripping the modifiers. That character
must be a digit."
(insert string)))
(current-buffer)))
+(defvar company--electric-saved-window-configuration nil)
+
(defvar company--electric-commands
- '(scroll-other-window scroll-other-window-down)
+ '(scroll-other-window scroll-other-window-down mwheel-scroll)
"List of Commands that won't break out of electric commands.")
+(defun company--electric-restore-window-configuration ()
+ "Restore window configuration (after electric commands)."
+ (when (and company--electric-saved-window-configuration
+ (not (memq this-command company--electric-commands)))
+ (set-window-configuration company--electric-saved-window-configuration)
+ (setq company--electric-saved-window-configuration nil)))
+
(defmacro company--electric-do (&rest body)
(declare (indent 0) (debug t))
`(when (company-manual-begin)
- (save-window-excursion
- (let ((height (window-height))
- (row (company--row))
- cmd)
- ,@body
- (and (< (window-height) height)
- (< (- (window-height) row 2) company-tooltip-limit)
- (recenter (- (window-height) row 2)))
- (while (memq (setq cmd (key-binding (vector (list (read-event)))))
- company--electric-commands)
- (call-interactively cmd))
- (company--unread-last-input)))))
+ (cl-assert (null company--electric-saved-window-configuration))
+ (setq company--electric-saved-window-configuration
(current-window-configuration))
+ (let ((height (window-height))
+ (row (company--row)))
+ ,@body
+ (and (< (window-height) height)
+ (< (- (window-height) row 2) company-tooltip-limit)
+ (recenter (- (window-height) row 2))))))
(defun company--unread-last-input ()
(when last-input-event
@@ -2042,32 +2211,39 @@ character, stripping the modifiers. That character
must be a digit."
(defun company-show-doc-buffer ()
"Temporarily show the documentation buffer for the selection."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (doc-buffer (or (company-call-backend 'doc-buffer selected)
- (error "No documentation available"))))
- (with-current-buffer doc-buffer
- (goto-char (point-min)))
- (display-buffer doc-buffer t))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (doc-buffer (or (company-call-backend 'doc-buffer selected)
+ (error "No documentation available")))
+ start)
+ (when (consp doc-buffer)
+ (setq start (cdr doc-buffer)
+ doc-buffer (car doc-buffer)))
+ (setq other-window-scroll-buffer (get-buffer doc-buffer))
+ (let ((win (display-buffer doc-buffer t)))
+ (set-window-start win (if start start (point-min))))))))
(put 'company-show-doc-buffer 'company-keep t)
(defun company-show-location ()
"Temporarily display a buffer showing the selected candidate in context."
(interactive)
- (company--electric-do
- (let* ((selected (nth company-selection company-candidates))
- (location (company-call-backend 'location selected))
- (pos (or (cdr location) (error "No location available")))
- (buffer (or (and (bufferp (car location)) (car location))
- (find-file-noselect (car location) t))))
- (with-selected-window (display-buffer buffer t)
- (save-restriction
- (widen)
- (if (bufferp (car location))
- (goto-char pos)
- (goto-char (point-min))
- (forward-line (1- pos))))
- (set-window-start nil (point))))))
+ (let (other-window-scroll-buffer)
+ (company--electric-do
+ (let* ((selected (nth company-selection company-candidates))
+ (location (company-call-backend 'location selected))
+ (pos (or (cdr location) (error "No location available")))
+ (buffer (or (and (bufferp (car location)) (car location))
+ (find-file-noselect (car location) t))))
+ (setq other-window-scroll-buffer (get-buffer buffer))
+ (with-selected-window (display-buffer buffer t)
+ (save-restriction
+ (widen)
+ (if (bufferp (car location))
+ (goto-char pos)
+ (goto-char (point-min))
+ (forward-line (1- pos))))
+ (set-window-start nil (point)))))))
(put 'company-show-location 'company-keep t)
;;; package functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2081,7 +2257,7 @@ character, stripping the modifiers. That character must
be a digit."
(defun company-begin-backend (backend &optional callback)
"Start a completion at point using BACKEND."
- (interactive (let ((val (completing-read "Company back-end: "
+ (interactive (let ((val (completing-read "Company backend: "
obarray
'functionp nil "company-")))
(when val
@@ -2119,18 +2295,62 @@ Example: \(company-begin-with '\(\"foo\" \"foobar\"
\"foobarbaz\"\)\)"
require-match)))
callback)))
+(declare-function find-library-name "find-func")
+(declare-function lm-version "lisp-mnt")
+
(defun company-version (&optional show-version)
"Get the Company version as string.
If SHOW-VERSION is non-nil, show the version in the echo area."
(interactive (list t))
(with-temp-buffer
+ (require 'find-func)
(insert-file-contents (find-library-name "company"))
(require 'lisp-mnt)
(if show-version
(message "Company version: %s" (lm-version))
(lm-version))))
+(defun company-diag ()
+ "Pop a buffer with information about completions at point."
+ (interactive)
+ (let* ((bb company-backends)
+ backend
+ (prefix (cl-loop for b in bb
+ thereis (let ((company-backend b))
+ (setq backend b)
+ (company-call-backend 'prefix))))
+ cc annotations)
+ (when (stringp prefix)
+ (let ((company-backend backend))
+ (setq cc (company-call-backend 'candidates prefix)
+ annotations
+ (mapcar
+ (lambda (c) (cons c (company-call-backend 'annotation c)))
+ cc))))
+ (pop-to-buffer (get-buffer-create "*company-diag*"))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert (format "Emacs %s (%s) of %s on %s"
+ emacs-version system-configuration
+ (format-time-string "%Y-%m-%d" emacs-build-time)
+ emacs-build-system))
+ (insert "\nCompany " (company-version) "\n\n")
+ (insert "company-backends: " (pp-to-string bb))
+ (insert "\n")
+ (insert "Used backend: " (pp-to-string backend))
+ (insert "\n")
+ (insert "Prefix: " (pp-to-string prefix))
+ (insert "\n")
+ (insert (message "Completions:"))
+ (unless cc (insert " none"))
+ (save-excursion
+ (dolist (c annotations)
+ (insert "\n " (prin1-to-string (car c)))
+ (when (cdr c)
+ (insert " " (prin1-to-string (cdr c))))))
+ (special-mode)))
+
;;; pseudo-tooltip
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-pseudo-tooltip-overlay nil)
@@ -2188,6 +2408,8 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(if company-common
(string-width company-common)
0)))
+ (_ (setq value (company--pre-render value)
+ annotation (and annotation (company--pre-render annotation
t))))
(ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width
(+ (length value) (length annotation)
@@ -2214,38 +2436,62 @@ If SHOW-VERSION is non-nil, show the version in the
echo area."
(setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
- (add-text-properties 0 width '(face company-tooltip
- mouse-face company-tooltip-mouse)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common
- mouse-face company-tooltip-mouse)
- line)
+ (font-lock-append-text-property 0 width 'mouse-face
+ 'company-tooltip-mouse
+ line)
(when (< ann-start ann-end)
- (add-text-properties ann-start ann-end
- '(face company-tooltip-annotation
- mouse-face company-tooltip-mouse)
- line))
+ (font-lock-append-text-property ann-start ann-end 'face
+ (if selected
+ 'company-tooltip-annotation-selection
+ 'company-tooltip-annotation)
+ line))
+ (font-lock-prepend-text-property margin common 'face
+ (if selected
+ 'company-tooltip-common-selection
+ 'company-tooltip-common)
+ line)
(when selected
- (if (and (not (string= company-search-string ""))
- (string-match (regexp-quote company-search-string) value
- (length company-prefix)))
- (let ((beg (+ margin (match-beginning 0)))
- (end (+ margin (match-end 0)))
- (width (- width (length right))))
- (when (< beg width)
- (add-text-properties beg (min end width)
- '(face company-tooltip-search)
- line)))
- (add-text-properties 0 width '(face company-tooltip-selection
- mouse-face company-tooltip-selection)
- line)
- (add-text-properties margin common
- '(face company-tooltip-common-selection
- mouse-face company-tooltip-selection)
- line)))
+ (if (let ((re (funcall company-search-regexp-function
+ company-search-string)))
+ (and (not (string= re ""))
+ (string-match re value (length company-prefix))))
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (let ((beg (+ margin mbeg))
+ (end (+ margin mend))
+ (width (- width (length right))))
+ (when (< beg width)
+ (font-lock-prepend-text-property beg (min end width)
+ 'face 'company-tooltip-search
+ line))))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip-selection
+ line)))
+ (font-lock-append-text-property 0 width 'face
+ 'company-tooltip
+ line)
line))
+(defun company--search-chunks ()
+ (let ((md (match-data t))
+ res)
+ (if (<= (length md) 2)
+ (push (cons (nth 0 md) (nth 1 md)) res)
+ (while (setq md (nthcdr 2 md))
+ (when (car md)
+ (push (cons (car md) (cadr md)) res))))
+ res))
+
+(defun company--pre-render (str &optional annotation-p)
+ (or (company-call-backend 'pre-render str annotation-p)
+ (progn
+ (when (or (text-property-not-all 0 (length str) 'face nil str)
+ (text-property-not-all 0 (length str) 'mouse-face nil str))
+ (setq str (copy-sequence str))
+ (remove-text-properties 0 (length str)
+ '(face nil font-lock-face nil mouse-face nil)
+ str))
+ str)))
+
(defun company--clean-string (str)
(replace-regexp-in-string
"\\([^[:graph:] ]\\)\\|\\(\ufeff\\)\\|[[:multibyte:]]"
@@ -2273,7 +2519,7 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(while (and (not (eobp)) ; http://debbugs.gnu.org/19553
(> (setq lines-moved (vertical-motion 1)) 0)
(<= (point) end))
- (let ((bound (min end (1- (point)))))
+ (let ((bound (min end (point))))
;; A visual line can contain several physical lines (e.g. with
outline's
;; folding overlay). Take only the first one.
(push (buffer-substring beg
@@ -2321,8 +2567,12 @@ If SHOW-VERSION is non-nil, show the version in the echo
area."
(or (cdr margins) 0)))))
(when (and word-wrap
(version< emacs-version "24.4.51.5"))
- ;; http://debbugs.gnu.org/18384
+ ;; http://debbugs.gnu.org/19300
(cl-decf ww))
+ ;; whitespace-mode with newline-mark
+ (when (and buffer-display-table
+ (aref buffer-display-table ?\n))
+ (cl-decf ww (1- (length (aref buffer-display-table ?\n)))))
ww))
(defun company--replacement-string (lines old column nl &optional align-top)
@@ -2357,8 +2607,7 @@ 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"
+ (let ((str (concat (when nl " \n")
(mapconcat 'identity (nreverse new) "\n")
"\n")))
(font-lock-append-text-property 0 (length str) 'face 'default str)
@@ -2510,7 +2759,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(end (save-excursion
(move-to-window-line (+ row (abs height)))
(point)))
- (ov (make-overlay (if nl beg (1- beg)) end nil t))
+ (ov (make-overlay beg end nil t))
(args (list (mapcar 'company-plainify
(company-buffer-lines beg end))
column nl above)))
@@ -2551,7 +2800,9 @@ Returns a negative number if the tooltip should be
displayed above point."
(defun company-pseudo-tooltip-hide-temporarily ()
(when (overlayp company-pseudo-tooltip-overlay)
(overlay-put company-pseudo-tooltip-overlay 'invisible nil)
- (overlay-put company-pseudo-tooltip-overlay 'after-string nil)))
+ (overlay-put company-pseudo-tooltip-overlay 'line-prefix nil)
+ (overlay-put company-pseudo-tooltip-overlay 'after-string nil)
+ (overlay-put company-pseudo-tooltip-overlay 'display nil)))
(defun company-pseudo-tooltip-unhide ()
(when company-pseudo-tooltip-overlay
@@ -2559,12 +2810,15 @@ Returns a negative number if the tooltip should be
displayed above point."
(disp (overlay-get ov 'company-display)))
;; Beat outline's folding overlays, at least.
(overlay-put ov 'priority 1)
- ;; `display' could be better (http://debbugs.gnu.org/18285), but it
- ;; doesn't work when the overlay is empty, which is what happens at eob.
- ;; It also seems to interact badly with `cursor'.
- ;; We deal with priorities by having the overlay start before the
newline.
- (overlay-put ov 'after-string disp)
- (overlay-put ov 'invisible t)
+ ;; 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 'window (selected-window)))))
(defun company-pseudo-tooltip-guard ()
@@ -2579,7 +2833,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(when (>= overhang 0) overhang))))))
(defun company-pseudo-tooltip-frontend (command)
- "`company-mode' front-end similar to a tooltip but based on overlays."
+ "`company-mode' frontend similar to a tooltip but based on overlays."
(cl-case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
@@ -2608,6 +2862,30 @@ Returns a negative number if the tooltip should be
displayed above point."
(company--show-inline-p))
(company-pseudo-tooltip-frontend command)))
+(defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command)
+ "`compandy-pseudo-tooltip-frontend', but shown after a delay.
+Delay is determined by `company-tooltip-idle-delay'."
+ (cl-case command
+ (pre-command
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (when company-tooltip-timer
+ (cancel-timer company-tooltip-timer)
+ (setq company-tooltip-timer nil)))
+ (post-command
+ (if (or company-tooltip-timer
+ (overlayp company-pseudo-tooltip-overlay))
+ (if (not (memq 'company-preview-frontend company-frontends))
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (company-preview-frontend 'pre-command)
+ (company-pseudo-tooltip-unless-just-one-frontend command)
+ (company-preview-frontend 'post-command))
+ (setq company-tooltip-timer
+ (run-with-timer company-tooltip-idle-delay nil
+
'company-pseudo-tooltip-unless-just-one-frontend-with-delay
+ 'post-command))))
+ (t
+ (company-pseudo-tooltip-unless-just-one-frontend command))))
+
;;; overlay
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-preview-overlay nil)
@@ -2616,17 +2894,22 @@ Returns a negative number if the tooltip should be
displayed above point."
(company-preview-hide)
(let ((completion (nth company-selection company-candidates)))
- (setq completion (propertize completion 'face 'company-preview))
- (add-text-properties 0 (length company-common)
- '(face company-preview-common) completion)
+ (setq completion (copy-sequence (company--pre-render completion)))
+ (font-lock-append-text-property 0 (length completion)
+ 'face 'company-preview
+ completion)
+ (font-lock-prepend-text-property 0 (length company-common)
+ 'face 'company-preview-common
+ completion)
;; Add search string
- (and company-search-string
- (string-match (regexp-quote company-search-string) completion)
- (add-text-properties (match-beginning 0)
- (match-end 0)
- '(face company-preview-search)
- completion))
+ (and (string-match (funcall company-search-regexp-function
+ company-search-string)
+ completion)
+ (pcase-dolist (`(,mbeg . ,mend) (company--search-chunks))
+ (font-lock-prepend-text-property mbeg mend
+ 'face 'company-preview-search
+ completion)))
(setq completion (company-strip-prefix completion))
@@ -2659,7 +2942,7 @@ Returns a negative number if the tooltip should be
displayed above point."
(setq company-preview-overlay nil)))
(defun company-preview-frontend (command)
- "`company-mode' front-end showing the selection as if it had been inserted."
+ "`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)))
@@ -2677,6 +2960,11 @@ Returns a negative number if the tooltip should be
displayed above point."
(or (eq (company-call-backend 'ignore-case) 'keep-prefix)
(string-prefix-p company-prefix company-common))))
+(defun company-tooltip-visible-p ()
+ "Returns whether the tooltip is visible."
+ (when (overlayp company-pseudo-tooltip-overlay)
+ (not (overlay-get company-pseudo-tooltip-overlay 'invisible))))
+
;;; echo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-echo-last-msg nil)
@@ -2694,13 +2982,19 @@ Returns a negative number if the tooltip should be
displayed above point."
(message ""))))
(defun company-echo-show-soon (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+
+(defun company-echo-cancel (&optional unset)
(when company-echo-timer
(cancel-timer company-echo-timer))
- (setq company-echo-timer (run-with-timer 0 nil 'company-echo-show getter)))
+ (when unset
+ (setq company-echo-timer nil)))
-(defsubst company-echo-show-when-idle (&optional getter)
- (when (sit-for company-echo-delay)
- (company-echo-show getter)))
+(defun company-echo-show-when-idle (&optional getter)
+ (company-echo-cancel)
+ (setq company-echo-timer
+ (run-with-idle-timer company-echo-delay nil 'company-echo-show
getter)))
(defun company-echo-format ()
@@ -2763,19 +3057,19 @@ Returns a negative number if the tooltip should be
displayed above point."
(company-echo-show)))
(defun company-echo-frontend (command)
- "`company-mode' front-end showing the candidates in the echo area."
+ "`company-mode' frontend showing the candidates in the echo area."
(pcase command
(`post-command (company-echo-show-soon 'company-echo-format))
(`hide (company-echo-hide))))
(defun company-echo-strip-common-frontend (command)
- "`company-mode' front-end showing the candidates in the echo area."
+ "`company-mode' frontend showing the candidates in the echo area."
(pcase command
(`post-command (company-echo-show-soon 'company-echo-strip-common-format))
(`hide (company-echo-hide))))
(defun company-echo-metadata-frontend (command)
- "`company-mode' front-end showing the documentation in the echo area."
+ "`company-mode' frontend showing the documentation in the echo area."
(pcase command
(`post-command (company-echo-show-when-idle 'company-fetch-metadata))
(`hide (company-echo-hide))))
diff --git a/packages/company/test/async-tests.el
b/packages/company/test/async-tests.el
index c548898..48ebdfb 100644
--- a/packages/company/test/async-tests.el
+++ b/packages/company/test/async-tests.el
@@ -83,7 +83,9 @@
(should (null company-candidates))
(insert "a")
(sleep-for 0.1)
- (should (null company-candidates)))))
+ (should (null company-candidates))
+ (should (null company-candidates-cache))
+ (should (null company-backend)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
diff --git a/packages/company/test/bbdb-tests.el
b/packages/company/test/bbdb-tests.el
new file mode 100644
index 0000000..b1f21b9
--- /dev/null
+++ b/packages/company/test/bbdb-tests.el
@@ -0,0 +1,46 @@
+;;; bbdb-tests.el --- company-mode tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov
+
+;; 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/>.
+
+(require 'company-tests)
+(require 'company-bbdb)
+
+(provide 'bbdb-com)
+
+(ert-deftest company-bbdb-prefix-looks-in-header-value ()
+ (with-temp-buffer
+ (insert "To: J")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "J"))))
+
+(ert-deftest company-bbdb-prefix-includes-space ()
+ (with-temp-buffer
+ (insert "To: John Sm")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "John Sm"))))
+
+(ert-deftest company-bbdb-prefix-begins-after-comma-or-semi ()
+ (with-temp-buffer
+ (insert "To: John Smythe <address@hidden>, Jess C")
+ (setq-local major-mode 'message-mode)
+ (should (equal (company-bbdb 'prefix)
+ "Jess C"))))
diff --git a/packages/company/test/clang-tests.el
b/packages/company/test/clang-tests.el
index 09ba114..2b8b105 100644
--- a/packages/company/test/clang-tests.el
+++ b/packages/company/test/clang-tests.el
@@ -22,15 +22,6 @@
(require 'company-tests)
(require 'company-clang)
-(ert-deftest company-clang-objc-templatify ()
- (with-temp-buffer
- (let ((text "createBookWithTitle:andAuthor:"))
- (insert text)
- (company-clang-objc-templatify text)
- (should (equal "createBookWithTitle:arg0 andAuthor:arg1"
(buffer-string)))
- (should (looking-at "arg0"))
- (should (null (overlay-get (company-template-field-at) 'display))))))
-
(ert-deftest company-clang-simple-annotation ()
(let ((str (propertize
"foo" 'meta
@@ -44,3 +35,11 @@
"shared_ptr<_Tp> make_shared<typename _Tp>(_Args &&__args...)")))
(should (equal (company-clang 'annotation str)
"<typename _Tp>(_Args &&__args...)"))))
+
+(ert-deftest company-clang-func-ptr-annotation ()
+ (let ((str (propertize "foo" 'meta "void (*)(int) foo")))
+ (should (equal (company-clang 'annotation str) "(*)(int)"))))
+
+(ert-deftest company-clang-null-annotation ()
+ (let ((str "char"))
+ (should (null (company-clang 'annotation str)))))
diff --git a/packages/company/test/core-tests.el
b/packages/company/test/core-tests.el
index 13e547e..89543b0 100644
--- a/packages/company/test/core-tests.el
+++ b/packages/company/test/core-tests.el
@@ -1,6 +1,6 @@
;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@@ -153,6 +153,26 @@
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
+(ert-deftest company-multi-backend-handles-keyword-separate ()
+ (let ((one (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("aa" "ca" "ba")))))
+ (two (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("bb" "ab")))))
+ (tri (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (sorted t)
+ (candidates '("cc" "bc" "ac"))))))
+ (let ((company-backend (list one two tri :separate)))
+ (should (company-call-backend 'sorted))
+ (should-not (company-call-backend 'duplicates))
+ (should (equal '("aa" "ba" "ca" "ab" "bb" "cc" "bc" "ac")
+ (company-call-backend 'candidates "a"))))))
+
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
@@ -399,6 +419,9 @@
(and (ert-equal-including-properties (car list1) (car list2))
(ct-equal-including-properties (cdr list1) (cdr list2)))))
+(ert-deftest company-strips-duplicates-returns-nil ()
+ (should (null (company--preprocess-candidates nil))))
+
(ert-deftest company-strips-duplicates-within-groups ()
(let* ((kvs '(("a" . "b")
("a" . nil)
diff --git a/packages/company/test/frontends-tests.el
b/packages/company/test/frontends-tests.el
index 613856e..7b8ee61 100644
--- a/packages/company/test/frontends-tests.el
+++ b/packages/company/test/frontends-tests.el
@@ -1,6 +1,6 @@
;;; frontends-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
@@ -31,12 +31,12 @@
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
- (list (lambda (c &optional _)
+ (list (lambda (c &rest _)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
- (should (eq 1 (overlay-start company-pseudo-tooltip-overlay)))))))
+ (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
(ert-deftest company-pseudo-tooltip-show ()
:tags '(interactive)
@@ -57,7 +57,7 @@
(should (eq (overlay-get ov 'company-height) company-tooltip-limit))
(should (eq (overlay-get ov 'company-column) col))
(should (string= (overlay-get ov 'company-display)
- "\n 123 \nc 45 c\nddd\n")))))))
+ " 123 \nc 45 c\nddd\n")))))))
(ert-deftest company-pseudo-tooltip-edit-updates-width ()
:tags '(interactive)
@@ -84,7 +84,8 @@
(set-window-buffer nil (current-buffer))
(save-excursion (insert "\n"))
(let ((company-candidates-length 1)
- (company-candidates '("123")))
+ (company-candidates '("123"))
+ (company-backend #'ignore))
(company-preview-show-at-point (point))
(let* ((ov company-preview-overlay)
(str (overlay-get ov 'after-string)))
@@ -109,7 +110,7 @@
;; With margins.
(should (eq (overlay-get ov 'company-width) 8))
(should (string= (overlay-get ov 'company-display)
- "\n 123(4) \n 45 \n")))))))
+ " 123(4) \n 45 \n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
:tags '(interactive)
@@ -130,7 +131,7 @@
;; With margins.
(should (eq (overlay-get ov 'company-width) 13))
(should (string= (overlay-get ov 'company-display)
- "\n 123 (4) \n 45 \n 67 (891011)
\n")))))))
+ " 123 (4) \n 45 \n 67 (891011)
\n")))))))
(ert-deftest company-create-lines-shows-numbers ()
(let ((company-show-numbers t)
@@ -149,7 +150,7 @@
(company-candidates (mapcar #'car data))
(company-candidates-length 4)
(company-tooltip-margin 1)
- (company-backend (lambda (cmd &optional arg)
+ (company-backend (lambda (cmd &optional arg &rest _)
(when (eq cmd 'annotation)
(cdr (assoc arg data)))))
company-tooltip-align-annotations)
@@ -189,12 +190,15 @@
(should (equal (list (format " %s " (make-string (- ww 2) ?1))
(format " %s " (make-string (- ww 2) ?1)))
res))
- (should (eq 'company-tooltip-common-selection
- (get-text-property (- ww 2) 'face
- (car res))))
- (should (eq 'company-tooltip-selection
- (get-text-property (1- ww) 'face
- (car res))))
+ (should (equal '(company-tooltip-common-selection
+ company-tooltip-selection
+ company-tooltip)
+ (get-text-property (- ww 2) 'face
+ (car res))))
+ (should (equal '(company-tooltip-selection
+ company-tooltip)
+ (get-text-property (1- ww) 'face
+ (car res))))
)))
(ert-deftest company-create-lines-clears-out-non-printables ()
@@ -224,7 +228,7 @@
(alist '(("a" . " ︸") ("b" . " ︸︸")))
(company-candidates (mapcar #'car alist))
(company-candidates-length 2)
- (company-backend (lambda (c &optional a)
+ (company-backend (lambda (c &optional a &rest _)
(when (eq c 'annotation)
(assoc-default a alist)))))
(should (equal '(" a ︸ "
@@ -238,7 +242,7 @@
"MIRAI発売2カ月"))
(company-candidates-length 2)
(company-prefix "MIRAI発")
- (company-backend (lambda (c &optional _arg)
+ (company-backend (lambda (c &rest _)
(pcase c
(`ignore-case 'keep-prefix)))))
(should (equal '(" MIRAI発売1カ月 "
@@ -249,21 +253,54 @@
(let ((company-search-string "foo")
(company-backend #'ignore)
(company-prefix ""))
- (should (equal-including-properties
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 6 t nil nil)
#("barfoo"
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 6 (face company-tooltip-search mouse-face
company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 6 (face (company-tooltip-search company-tooltip) mouse-face
(company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 5 t "" " ")
#("barfo "
- 0 3 (face company-tooltip mouse-face company-tooltip-mouse)
- 3 5 (face company-tooltip-search mouse-face
company-tooltip-mouse)
- 5 6 (face company-tooltip mouse-face company-tooltip-mouse))))
- (should (equal-including-properties
+ 0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 3 5 (face (company-tooltip-search company-tooltip) mouse-face
(company-tooltip-mouse))
+ 5 6 (face (company-tooltip) mouse-face
(company-tooltip-mouse)))))
+ (should (ert-equal-including-properties
(company-fill-propertize "barfoo" nil 3 t " " " ")
#(" bar "
- 0 5 (face company-tooltip mouse-face company-tooltip-mouse))))))
+ 0 5 (face (company-tooltip) mouse-face
(company-tooltip-mouse)))))))
+
+(ert-deftest company-fill-propertize-overrides-face-property ()
+ (let ((company-backend #'ignore)
+ (company-prefix "")
+ (str1 (propertize "str1" 'face 'foo))
+ (str2 (propertize "str2" 'face 'foo)))
+ (should (ert-equal-including-properties
+ (company-fill-propertize str1 str2 8 nil nil nil)
+ #("str1str2"
+ 0 4 (face (company-tooltip) mouse-face (company-tooltip-mouse))
+ 4 8 (face (company-tooltip-annotation company-tooltip)
+ mouse-face (company-tooltip-mouse)))))))
+
+(ert-deftest company-fill-propertize-delegates-to-pre-render ()
+ (let ((company-backend
+ (lambda (command &rest args)
+ (pcase command
+ (`pre-render
+ (propertize (car args)
+ 'face (if (cadr args)
+ 'annotation
+ 'value))))))
+ (company-prefix "")
+ (str1 (propertize "str1" 'foo 'bar))
+ (str2 (propertize "str2" 'foo 'bar)))
+ (let ((res (company-fill-propertize str1 str2 8 nil nil nil)))
+ ;; Could use `ert-equal-including-properties' as well.
+ (should (eq (get-text-property 0 'foo res) 'bar))
+ (should (eq (get-text-property 4 'foo res) 'bar))
+ (should (equal (get-text-property 0 'face res)
+ '(value company-tooltip)))
+ (should (equal (get-text-property 4 'face res)
+ '(annotation company-tooltip-annotation
company-tooltip))))))
(ert-deftest company-column-with-composition ()
:tags '(interactive)
@@ -299,7 +336,7 @@
(insert (propertize "a" 'display "bbb\nccc\ndddd\n"))
(insert "eee\nfff\nggg")
(should (equal (company-buffer-lines (point-min) (point-max))
- '("" "" "" "eee" "fff" "ggg")))))
+ '("a" "" "" "eee" "fff" "ggg")))))
(ert-deftest company-buffer-lines-with-multiline-after-string-at-eob ()
:tags '(interactive)
@@ -310,6 +347,16 @@
(should (equal (company-buffer-lines (point-min) (point-max))
'("a" "b" "c")))))
+(ert-deftest company-buffer-lines-with-line-wrapping ()
+ :tags '(interactive)
+ (with-temp-buffer
+ (let ((ww (company--window-width)))
+ (insert (make-string (* 3 ww) ?a))
+ (should (equal (company-buffer-lines (point-min) (point-max))
+ (list (make-string ww ?a)
+ (make-string ww ?a)
+ (make-string ww ?a)))))))
+
(ert-deftest company-modify-line ()
(let ((str "-*-foobar"))
(should (equal-including-properties
diff --git a/packages/company/test/template-tests.el
b/packages/company/test/template-tests.el
index 09548c4..da746bd 100644
--- a/packages/company/test/template-tests.el
+++ b/packages/company/test/template-tests.el
@@ -22,6 +22,13 @@
(require 'company-tests)
(require 'company-template)
+(defun company-template-field-assert-text (str &optional pos)
+ (let ((field (company-template-field-at pos)))
+ (should (equal (buffer-substring-no-properties
+ (overlay-start field)
+ (overlay-end field))
+ str))))
+
(ert-deftest company-template-removed-after-the-last-jump ()
(with-temp-buffer
(insert "{ }")
@@ -29,8 +36,8 @@
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(dotimes (_ 2)
- (insert " ")
- (company-template-add-field tpl (point) "foo")))
+ (insert " foo")
+ (company-template-add-field tpl (- (point) 3) (point))))
(company-call 'template-forward-field)
(should (= 3 (point)))
(company-call 'template-forward-field)
@@ -46,8 +53,8 @@
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
- (insert " ")
- (company-template-add-field tpl (point) "bar"))
+ (insert " bar")
+ (company-template-add-field tpl (- (point) 3) (point)))
(company-call 'template-move-to-first tpl)
(should (= 3 (point)))
(dolist (c (string-to-list "tee"))
@@ -64,28 +71,49 @@
(let ((text "foo(int a, short b)"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo(arg0, arg1)" (buffer-string)))
- (should (looking-at "arg0"))
- (should (equal "int a"
- (overlay-get (company-template-field-at) 'display))))))
+ (should (equal "foo(int a, short b)" (buffer-string)))
+ (company-template-field-assert-text "int a"))))
(ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
(with-temp-buffer
(let ((text "foo(int a, short b)!@ #1334 a"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo(arg0, arg1)" (buffer-string)))
- (should (looking-at "arg0")))))
+ (should (equal "foo(int a, short b)" (buffer-string)))
+ (company-template-field-assert-text "int a"))))
(ert-deftest company-template-c-like-templatify-generics ()
(with-temp-buffer
(let ((text "foo<TKey, TValue>(int i, Dict<TKey, TValue>, long l)"))
(insert text)
(company-template-c-like-templatify text)
- (should (equal "foo<arg0, arg1>(arg2, arg3, arg4)" (buffer-string)))
- (should (looking-at "arg0"))
- (should (equal "TKey" (overlay-get (company-template-field-at)
'display)))
- (search-forward "arg3")
+ (should (equal (buffer-string) text))
+ (company-template-field-assert-text "TKey")
+ (search-forward "Dict")
(forward-char -1)
- (should (equal "Dict<TKey, TValue>"
- (overlay-get (company-template-field-at) 'display))))))
+ (company-template-field-assert-text "Dict<TKey, TValue>"))))
+
+(ert-deftest company-template-c-like-func-ptr ()
+ (with-temp-buffer
+ (let ((text "foo(*)(int)"))
+ (insert text)
+ (company-template-c-like-templatify text)
+ (should (equal (buffer-string) "foo(int)"))
+ (company-template-field-assert-text "int"))))
+
+(ert-deftest company-clang-objc-templatify-empty-args ()
+ (with-temp-buffer
+ (let ((text "createBookWithTitle:andAuthor:"))
+ (insert text)
+ (company-template-objc-templatify text)
+ (should (equal "createBookWithTitle:arg0 andAuthor:arg1"
(buffer-string)))
+ (should (looking-at "arg0"))
+ (should (null (overlay-get (company-template-field-at) 'display))))))
+
+(ert-deftest company-template-objc-templatify ()
+ (with-temp-buffer
+ (let ((text "createBookWithTitle:(NSString) andAuthor:(id)"))
+ (insert text)
+ (company-template-objc-templatify text)
+ (should (equal (buffer-string) text))
+ (company-template-field-assert-text "(NSString)"))))
- [elpa] master 7d2d49b 150/173: company--fetch-candidates: Bind non-essential, (continued)
- [elpa] master 7d2d49b 150/173: company--fetch-candidates: Bind non-essential, Dmitry Gutov, 2016/06/22
- [elpa] master 90ec4ce 153/173: Don't call company-abort right after startup, Dmitry Gutov, 2016/06/22
- [elpa] master d48eaee 155/173: Merge pull request #499 from fice-t/autoload, Dmitry Gutov, 2016/06/22
- [elpa] master e0d2bf0 157/173: company-bbdb: Use full names as prefix, Dmitry Gutov, 2016/06/22
- [elpa] master 6067bc6 169/173: Mention company-sort-prefer-same-case-prefix, Dmitry Gutov, 2016/06/22
- [elpa] master adfb2d9 167/173: Mention company-pseudo-tooltip-unless-just-one-frontend-with-delay in NEWS, Dmitry Gutov, 2016/06/22
- [elpa] master ce38a7d 166/173: Replace :sorted with :separate, and sort within each chunk, Dmitry Gutov, 2016/06/22
- [elpa] master 971eea5 170/173: Bump copyright, Dmitry Gutov, 2016/06/22
- [elpa] master de9f2e1 163/173: Add support for auto-complete like behavior (#524), Dmitry Gutov, 2016/06/22
- [elpa] master 212c8fc 172/173: Make a new release, Dmitry Gutov, 2016/06/22
- [elpa] master 7a2deff 173/173: Merge commit '212c8fc3101781a2f1c55ca61772eb75a2046e87' from company,
Dmitry Gutov <=
- [elpa] master c6d5330 165/173: company-eclim--project-dir: Try to handle non-project buffers, Dmitry Gutov, 2016/06/22