From: Dmitry Gutov Date: Tue, 1 Apr 2014 01:33:24 +0000 (+0300) Subject: Initial support for asynchonous backends (#62) X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/52e32183d3338334b50da18ad9b450e73ad36564 Initial support for asynchonous backends (#62) --- diff --git a/Makefile b/Makefile index 2602191aa..4d7a9ad1c 100644 --- a/Makefile +++ b/Makefile @@ -22,11 +22,11 @@ clean: @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: diff --git a/NEWS.md b/NEWS.md index c206ee5d4..69ed56306 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## 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`. diff --git a/company-elisp-tests.el b/company-elisp-tests.el new file mode 100644 index 000000000..b027c5ec4 --- /dev/null +++ b/company-elisp-tests.el @@ -0,0 +1,191 @@ +;;; 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 . + + +;;; 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))))) diff --git a/company-tests.el b/company-tests.el index 6b7ce887a..b8a8067f7 100644 --- a/company-tests.el +++ b/company-tests.el @@ -1,4 +1,4 @@ -;;; company-tests.el --- company-mode tests +;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*- ;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc. @@ -508,6 +508,92 @@ (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 () @@ -574,173 +660,6 @@ (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 () diff --git a/company.el b/company.el index e5790a03e..44322d29d 100644 --- a/company.el +++ b/company.el @@ -395,7 +395,20 @@ 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 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" @@ -550,6 +563,13 @@ commands in the `company-' namespace, abort completion." "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) @@ -785,12 +805,27 @@ means that `company-mode' is always turned on except in `message-mode' buffers." 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 @@ -1005,16 +1040,9 @@ can retrieve meta-data for them." (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) @@ -1024,6 +1052,47 @@ can retrieve meta-data for them." ;; 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 @@ -1091,7 +1160,6 @@ Keywords and function definition names are ignored." (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)) @@ -1353,6 +1421,7 @@ Keywords and function definition names are ignored." (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