@rm -rf company-*/ company-*.tar company-*.tar.bz2 *.elc ert.el
test:
- ${EMACS} -Q -nw -L . -l company-tests.el \
+ ${EMACS} -Q -nw -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(let (pop-up-windows) (ert t))"
test-batch:
- ${EMACS} -Q --batch -L . -l company-tests.el \
+ ${EMACS} -Q --batch -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))"
downloads:
## Next
+* Added support for asynchronous back-ends (experimental).
* Support for back-end command `crop` dropped (it was never documented).
* Support for Emacs 23 dropped.
* New user option `company-abort-manual-when-too-short`.
--- /dev/null
+;;; company-elisp-tests.el --- company-elisp tests
+
+;; Copyright (C) 2013-2014 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/>.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(defmacro company-elisp-with-buffer (contents &rest body)
+ (declare (indent 0))
+ `(with-temp-buffer
+ (insert ,contents)
+ (setq major-mode 'emacs-lisp-mode)
+ (re-search-backward "|")
+ (replace-match "")
+ (let ((company-elisp-detect-function-context t))
+ ,@body)))
+
+(ert-deftest company-elisp-candidates-predicate ()
+ (company-elisp-with-buffer
+ "(foo ba|)"
+ (should (eq (company-elisp--candidates-predicate "ba")
+ 'boundp))
+ (should (eq (let (company-elisp-detect-function-context)
+ (company-elisp--candidates-predicate "ba"))
+ 'company-elisp--predicate)))
+ (company-elisp-with-buffer
+ "(foo| )"
+ (should (eq (company-elisp--candidates-predicate "foo")
+ 'fboundp))
+ (should (eq (let (company-elisp-detect-function-context)
+ (company-elisp--candidates-predicate "foo"))
+ 'company-elisp--predicate)))
+ (company-elisp-with-buffer
+ "(foo 'b|)"
+ (should (eq (company-elisp--candidates-predicate "b")
+ 'company-elisp--predicate))))
+
+(ert-deftest company-elisp-candidates-predicate-in-docstring ()
+ (company-elisp-with-buffer
+ "(def foo () \"Doo be doo `ide|"
+ (should (eq 'company-elisp--predicate
+ (company-elisp--candidates-predicate "ide")))))
+
+;; This one's also an integration test.
+(ert-deftest company-elisp-candidates-recognizes-binding-form ()
+ (let ((company-elisp-detect-function-context t)
+ (obarray [when what whelp])
+ (what 1)
+ (whelp 2)
+ (wisp 3))
+ (company-elisp-with-buffer
+ "(let ((foo 7) (wh| )))"
+ (should (equal '("what" "whelp")
+ (company-elisp-candidates "wh"))))
+ (company-elisp-with-buffer
+ "(cond ((null nil) (wh| )))"
+ (should (equal '("when")
+ (company-elisp-candidates "wh"))))))
+
+(ert-deftest company-elisp-candidates-predicate-binding-without-value ()
+ (loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp)
+ ("(let (foo (bar|" "bar" boundp)
+ ("(let (foo) (bar|" "bar" fboundp))
+ do
+ (eval `(company-elisp-with-buffer
+ ,text
+ (should (eq ',predicate
+ (company-elisp--candidates-predicate ,prefix)))))))
+
+(ert-deftest company-elisp-finds-vars ()
+ (let ((obarray [boo bar baz backquote])
+ (boo t)
+ (bar t)
+ (baz t))
+ (should (equal '("bar" "baz")
+ (company-elisp--globals "ba" 'boundp)))))
+
+(ert-deftest company-elisp-finds-functions ()
+ (let ((obarray [when what whelp])
+ (what t)
+ (whelp t))
+ (should (equal '("when")
+ (company-elisp--globals "wh" 'fboundp)))))
+
+(ert-deftest company-elisp-finds-things ()
+ (let ((obarray [when what whelp])
+ (what t)
+ (whelp t))
+ (should (equal '("what" "whelp" "when")
+ (sort (company-elisp--globals "wh" 'company-elisp--predicate)
+ 'string<)))))
+
+(ert-deftest company-elisp-locals-vars ()
+ (company-elisp-with-buffer
+ "(let ((foo 5) (bar 6))
+ (cl-labels ((borg ()))
+ (lambda (boo baz)
+ b|)))"
+ (should (equal '("bar" "baz" "boo")
+ (company-elisp--locals "b" nil)))))
+
+(ert-deftest company-elisp-locals-single-var ()
+ (company-elisp-with-buffer
+ "(dotimes (itk 100)
+ (dolist (item items)
+ it|))"
+ (should (equal '("itk" "item")
+ (company-elisp--locals "it" nil)))))
+
+(ert-deftest company-elisp-locals-funs ()
+ (company-elisp-with-buffer
+ "(cl-labels ((foo ())
+ (fee ()))
+ (let ((fun 4))
+ (f| )))"
+ (should (equal '("fee" "foo")
+ (sort (company-elisp--locals "f" t) 'string<)))))
+
+(ert-deftest company-elisp-locals-skips-current-varlist ()
+ (company-elisp-with-buffer
+ "(let ((foo 1)
+ (f| )))"
+ (should (null (company-elisp--locals "f" nil)))))
+
+(ert-deftest company-elisp-show-locals-first ()
+ (company-elisp-with-buffer
+ "(let ((floo 1)
+ (flop 2)
+ (flee 3))
+ fl|)"
+ (let ((obarray [float-pi]))
+ (let (company-elisp-show-locals-first)
+ (should (eq nil (company-elisp 'sorted))))
+ (let ((company-elisp-show-locals-first t))
+ (should (eq t (company-elisp 'sorted)))
+ (should (equal '("flee" "floo" "flop" "float-pi")
+ (company-elisp-candidates "fl")))))))
+
+(ert-deftest company-elisp-candidates-no-duplicates ()
+ (company-elisp-with-buffer
+ "(let ((float-pi 4))
+ f|)"
+ (let ((obarray [float-pi])
+ (company-elisp-show-locals-first t))
+ (should (equal '("float-pi") (company-elisp-candidates "f"))))))
+
+(ert-deftest company-elisp-shouldnt-complete-defun-name ()
+ (company-elisp-with-buffer
+ "(defun foob|)"
+ (should (null (company-elisp 'prefix)))))
+
+(ert-deftest company-elisp-should-complete-def-call ()
+ (company-elisp-with-buffer
+ "(defu|"
+ (should (equal "defu" (company-elisp 'prefix)))))
+
+(ert-deftest company-elisp-should-complete-in-defvar ()
+ ;; It will also complete the var name, at least for now.
+ (company-elisp-with-buffer
+ "(defvar abc de|"
+ (should (equal "de" (company-elisp 'prefix)))))
+
+(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist ()
+ (company-elisp-with-buffer
+ "(defsubst foobar (ba|"
+ (should (null (company-elisp 'prefix)))))
+
+(ert-deftest company-elisp-prefix-in-defun-body ()
+ (company-elisp-with-buffer
+ "(defun foob ()|)"
+ (should (equal "" (company-elisp 'prefix)))))
-;;; company-tests.el --- company-mode tests
+;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
(should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
(should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
+;;; Async
+
+(defun company-async-backend (command &optional arg)
+ (pcase command
+ (`prefix "foo")
+ (`candidates
+ (cons :async
+ (lambda (cb)
+ (run-with-timer 0.05 nil
+ #'funcall cb '("abc" "abd")))))))
+
+(ert-deftest company-call-backend-forces-sync ()
+ (let ((company-backend 'company-async-backend)
+ (company-async-timeout 0.1))
+ (should (equal '("abc" "abd") (company-call-backend 'candidates)))))
+
+(ert-deftest company-call-backend-errors-on-timeout ()
+ (with-temp-buffer
+ (let* ((company-backend (lambda (command &optional _arg)
+ (pcase command
+ (`candidates (cons :async 'ignore)))))
+ (company-async-timeout 0.1)
+ (err (should-error (company-call-backend 'candidates "foo"))))
+ (should (string-match-p "async timeout" (cadr err))))))
+
+(ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
+ (let ((company-backend 'company-async-backend))
+ (should (equal "foo" (company-call-backend-raw 'prefix)))
+ (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
+ (should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
+
+(ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
+ (with-temp-buffer
+ (company-mode)
+ (let (company-frontends
+ (company-backends (list 'company-async-backend)))
+ (company-manual-begin)
+ (should (equal "foo" company-prefix))
+ (should (equal '("abc" "abd") company-candidates)))))
+
+(ert-deftest company-idle-begin-allows-async-candidates ()
+ (with-temp-buffer
+ (company-mode)
+ (let (company-frontends
+ (company-backends (list 'company-async-backend)))
+ (company-idle-begin (current-buffer) (selected-window)
+ (buffer-chars-modified-tick) (point))
+ (should (null company-candidates))
+ (sleep-for 0.1)
+ (should (equal "foo" company-prefix))
+ (should (equal '("abc" "abd") company-candidates)))))
+
+(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
+ (with-temp-buffer
+ (company-mode)
+ (let (company-frontends
+ (company-backends (list 'company-async-backend)))
+ (company-idle-begin (current-buffer) (selected-window)
+ (buffer-chars-modified-tick) (point))
+ (should (null company-candidates))
+ (insert "a")
+ (sleep-for 0.1)
+ (should (null company-prefix))
+ (should (null company-candidates)))))
+
+(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
+ (with-temp-buffer
+ (company-mode)
+ (let (company-frontends
+ (company-backends
+ (list (lambda (command &optional arg)
+ (pcase command
+ (`prefix (buffer-substring (point-min) (point)))
+ (`candidates
+ (let ((c (all-completions arg '("abc" "def"))))
+ (cons :async
+ (lambda (cb) (funcall cb c)))))
+ (`no-cache t)))))
+ (company-minimum-prefix-length 0))
+ (company-idle-begin (current-buffer) (selected-window)
+ (buffer-chars-modified-tick) (point))
+ (should (equal '("abc" "def") company-candidates))
+ (let ((last-command-event ?a))
+ (company-call 'self-insert-command 1))
+ (should (equal '("abc") company-candidates)))))
+
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0")))))
-;;; Elisp
-
-(defmacro company-elisp-with-buffer (contents &rest body)
- (declare (indent 0))
- `(with-temp-buffer
- (insert ,contents)
- (setq major-mode 'emacs-lisp-mode)
- (re-search-backward "|")
- (replace-match "")
- (let ((company-elisp-detect-function-context t))
- ,@body)))
-
-(ert-deftest company-elisp-candidates-predicate ()
- (company-elisp-with-buffer
- "(foo ba|)"
- (should (eq (company-elisp--candidates-predicate "ba")
- 'boundp))
- (should (eq (let (company-elisp-detect-function-context)
- (company-elisp--candidates-predicate "ba"))
- 'company-elisp--predicate)))
- (company-elisp-with-buffer
- "(foo| )"
- (should (eq (company-elisp--candidates-predicate "foo")
- 'fboundp))
- (should (eq (let (company-elisp-detect-function-context)
- (company-elisp--candidates-predicate "foo"))
- 'company-elisp--predicate)))
- (company-elisp-with-buffer
- "(foo 'b|)"
- (should (eq (company-elisp--candidates-predicate "b")
- 'company-elisp--predicate))))
-
-(ert-deftest company-elisp-candidates-predicate-in-docstring ()
- (company-elisp-with-buffer
- "(def foo () \"Doo be doo `ide|"
- (should (eq 'company-elisp--predicate
- (company-elisp--candidates-predicate "ide")))))
-
-;; This one's also an integration test.
-(ert-deftest company-elisp-candidates-recognizes-binding-form ()
- (let ((company-elisp-detect-function-context t)
- (obarray [when what whelp])
- (what 1)
- (whelp 2)
- (wisp 3))
- (company-elisp-with-buffer
- "(let ((foo 7) (wh| )))"
- (should (equal '("what" "whelp")
- (company-elisp-candidates "wh"))))
- (company-elisp-with-buffer
- "(cond ((null nil) (wh| )))"
- (should (equal '("when")
- (company-elisp-candidates "wh"))))))
-
-(ert-deftest company-elisp-candidates-predicate-binding-without-value ()
- (loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp)
- ("(let (foo (bar|" "bar" boundp)
- ("(let (foo) (bar|" "bar" fboundp))
- do
- (eval `(company-elisp-with-buffer
- ,text
- (should (eq ',predicate
- (company-elisp--candidates-predicate ,prefix)))))))
-
-(ert-deftest company-elisp-finds-vars ()
- (let ((obarray [boo bar baz backquote])
- (boo t)
- (bar t)
- (baz t))
- (should (equal '("bar" "baz")
- (company-elisp--globals "ba" 'boundp)))))
-
-(ert-deftest company-elisp-finds-functions ()
- (let ((obarray [when what whelp])
- (what t)
- (whelp t))
- (should (equal '("when")
- (company-elisp--globals "wh" 'fboundp)))))
-
-(ert-deftest company-elisp-finds-things ()
- (let ((obarray [when what whelp])
- (what t)
- (whelp t))
- (should (equal '("what" "whelp" "when")
- (sort (company-elisp--globals "wh" 'company-elisp--predicate)
- 'string<)))))
-
-(ert-deftest company-elisp-locals-vars ()
- (company-elisp-with-buffer
- "(let ((foo 5) (bar 6))
- (cl-labels ((borg ()))
- (lambda (boo baz)
- b|)))"
- (should (equal '("bar" "baz" "boo")
- (company-elisp--locals "b" nil)))))
-
-(ert-deftest company-elisp-locals-single-var ()
- (company-elisp-with-buffer
- "(dotimes (itk 100)
- (dolist (item items)
- it|))"
- (should (equal '("itk" "item")
- (company-elisp--locals "it" nil)))))
-
-(ert-deftest company-elisp-locals-funs ()
- (company-elisp-with-buffer
- "(cl-labels ((foo ())
- (fee ()))
- (let ((fun 4))
- (f| )))"
- (should (equal '("fee" "foo")
- (sort (company-elisp--locals "f" t) 'string<)))))
-
-(ert-deftest company-elisp-locals-skips-current-varlist ()
- (company-elisp-with-buffer
- "(let ((foo 1)
- (f| )))"
- (should (null (company-elisp--locals "f" nil)))))
-
-(ert-deftest company-elisp-show-locals-first ()
- (company-elisp-with-buffer
- "(let ((floo 1)
- (flop 2)
- (flee 3))
- fl|)"
- (let ((obarray [float-pi]))
- (let (company-elisp-show-locals-first)
- (should (eq nil (company-elisp 'sorted))))
- (let ((company-elisp-show-locals-first t))
- (should (eq t (company-elisp 'sorted)))
- (should (equal '("flee" "floo" "flop" "float-pi")
- (company-elisp-candidates "fl")))))))
-
-(ert-deftest company-elisp-candidates-no-duplicates ()
- (company-elisp-with-buffer
- "(let ((float-pi 4))
- f|)"
- (let ((obarray [float-pi])
- (company-elisp-show-locals-first t))
- (should (equal '("float-pi") (company-elisp-candidates "f"))))))
-
-(ert-deftest company-elisp-shouldnt-complete-defun-name ()
- (company-elisp-with-buffer
- "(defun foob|)"
- (should (null (company-elisp 'prefix)))))
-
-(ert-deftest company-elisp-should-complete-def-call ()
- (company-elisp-with-buffer
- "(defu|"
- (should (equal "defu" (company-elisp 'prefix)))))
-
-(ert-deftest company-elisp-should-complete-in-defvar ()
- ;; It will also complete the var name, at least for now.
- (company-elisp-with-buffer
- "(defvar abc de|"
- (should (equal "de" (company-elisp 'prefix)))))
-
-(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist ()
- (company-elisp-with-buffer
- "(defsubst foobar (ba|"
- (should (null (company-elisp 'prefix)))))
-
-(ert-deftest company-elisp-prefix-in-defun-body ()
- (company-elisp-with-buffer
- "(defun foob ()|)"
- (should (equal "" (company-elisp 'prefix)))))
-
;;; Clang
(ert-deftest company-clang-objc-templatify ()
the keyword `:with', the back-ends after it are ignored for this command.
The completions from back-ends in a group are merged (but only from those
-that return the same `prefix')."
+that return the same `prefix').
+
+Asynchronous back-ends:
+
+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.
+
+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.
+
+Grouped back-ends can't work asynchronously (yet)."
:type `(repeat
(choice
:tag "Back-end"
"Work around a visualization bug when completing at the end of the buffer.
The work-around consists of adding a newline.")
+(defvar company-async-wait 0.03
+ "Pause between checks to see if the value's been set when turning an
+asynchronous call into synchronous.")
+
+(defvar company-async-timeout 2
+ "Maximum wait time for a value to be set during asynchronous call.")
+
;;; mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-mode-map (make-sparse-keymap)
dir (file-name-directory (directory-file-name dir))))))))
(defun company-call-backend (&rest args)
+ (let ((val (apply #'company-call-backend-raw args)))
+ (if (not (eq (car-safe val) :async))
+ val
+ (let ((res 'trash)
+ (start (time-to-seconds)))
+ (funcall (cdr val)
+ (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"
+ company-backend args)
+ (sleep-for company-async-wait)))
+ res))))
+
+(defun company-call-backend-raw (&rest args)
(condition-case err
(if (functionp company-backend)
(apply company-backend args)
- (apply 'company--multi-backend-adapter company-backend args))
+ (apply #'company--multi-backend-adapter company-backend args))
(error (error "Company: Back-end %s error \"%s\" with args %s"
- company-backend (error-message-string err) args))))
+ company-backend (error-message-string err) args))))
(defun company--multi-backend-adapter (backends command &rest args)
(let ((backends (loop for b in backends
(setq candidates (all-completions prefix prev))
(return t)))))
;; no cache match, call back-end
- (progn
- (setq candidates (company-call-backend 'candidates prefix))
- (when company-candidates-predicate
- (setq candidates
- (company-apply-predicate candidates
- company-candidates-predicate)))
- (unless (company-call-backend 'sorted)
- (setq candidates (sort candidates 'string<)))
- (when (company-call-backend 'duplicates)
- (company--strip-duplicates candidates))))
+ (setq candidates
+ (company--process-candidates
+ (company--fetch-candidates prefix))))
(setq candidates (company--transform-candidates candidates))
(when candidates
(if (or (cdr candidates)
;; Already completed and unique; don't start.
t))))
+(defun company--fetch-candidates (prefix)
+ (let ((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))
+ (win (selected-window))
+ (tick (buffer-chars-modified-tick))
+ (pt (point))
+ (backend company-backend))
+ (funcall
+ (cdr c)
+ (lambda (candidates)
+ (if (not (and candidates (eq res 'done)))
+ ;; Fetcher called us right back.
+ (setq res candidates)
+ (setq company-backend backend
+ company-candidates-cache
+ (list (cons prefix
+ (company--process-candidates
+ candidates))))
+ (company-idle-begin buf win tick pt)))))
+ ;; FIXME: Relying on the fact that the callers
+ ;; will interpret nil as "do nothing" is shaky.
+ ;; A throw-catch would be one possible improvement.
+ (or res
+ (progn (setq res 'done) nil)))))
+
+(defun company--process-candidates (candidates)
+ (when company-candidates-predicate
+ (setq candidates
+ (company-apply-predicate candidates
+ company-candidates-predicate)))
+ (unless (company-call-backend 'sorted)
+ (setq candidates (sort candidates 'string<)))
+ (when (company-call-backend 'duplicates)
+ (company--strip-duplicates candidates))
+ candidates)
+
(defun company--strip-duplicates (candidates)
(let ((c2 candidates))
(while c2
(eq win (selected-window))
(eq tick (buffer-chars-modified-tick))
(eq pos (point))
- (not (equal (point) company-point))
(when (company-auto-begin)
(when (version< emacs-version "24.3.50")
(company-input-noop))
(and (numberp company-idle-delay)
(or (eq t company-begin-commands)
(memq this-command company-begin-commands))
+ (not (equal (point) company-point))
(setq company-timer
(run-with-timer company-idle-delay nil
'company-idle-begin