diff options
| author | João Távora <joaotavora@gmail.com> | 2018-08-09 10:43:41 +0100 |
|---|---|---|
| committer | João Távora <joaotavora@gmail.com> | 2018-08-09 10:43:41 +0100 |
| commit | cdafa8933d0b5a2261e1cdb959703951eae98f74 (patch) | |
| tree | 7befac0678a0aad95fa5440bfc0fb0b4e0d71b71 /lisp/jsonrpc.el | |
| parent | 63a8f4cfd78b6fbf6d56cdeeb5df1f6d0688435c (diff) | |
| download | emacs-cdafa8933d0b5a2261e1cdb959703951eae98f74.tar.gz emacs-cdafa8933d0b5a2261e1cdb959703951eae98f74.tar.bz2 emacs-cdafa8933d0b5a2261e1cdb959703951eae98f74.zip | |
Synchronous JSONRPC requests can be cancelled on user input
This allows building more responsive interfaces, such as a snappier
completion backend.
* lisp/jsonrpc.el (Version): Bump to 1.0.1
(jsonrpc-connection-receive): Don't warn when continuation isn't
found.
(jsonrpc-request): Add parameters CANCEL-ON-INPUT and
CANCEL-ON-INPUT-RETVAL.
Diffstat (limited to 'lisp/jsonrpc.el')
| -rw-r--r-- | lisp/jsonrpc.el | 53 |
1 files changed, 36 insertions, 17 deletions
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b2ccea5c143..8e1e2aba333 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -6,7 +6,7 @@ ;; Maintainer: João Távora <joaotavora@gmail.com> ;; Keywords: processes, languages, extensions ;; Package-Requires: ((emacs "25.2")) -;; Version: 1.0.0 +;; Version: 1.0.1 ;; This is an Elpa :core package. Don't use functionality that is not ;; compatible with Emacs 25.2. @@ -193,9 +193,7 @@ dispatcher in CONNECTION." (when timer (cancel-timer timer))) (remhash id (jsonrpc--request-continuations connection)) (if error (funcall (nth 1 continuations) error) - (funcall (nth 0 continuations) result))) - (;; An abnormal situation - id (jsonrpc--warn "No continuation for id %s" id))) + (funcall (nth 0 continuations) result)))) (jsonrpc--call-deferred connection)))) @@ -256,17 +254,30 @@ Returns nil." (apply #'jsonrpc--async-request-1 connection method params args) nil) -(cl-defun jsonrpc-request (connection method params &key deferred timeout) +(cl-defun jsonrpc-request (connection + method params &key + deferred timeout + cancel-on-input + cancel-on-input-retval) "Make a request to CONNECTION, wait for a reply. Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, -but synchronous, i.e. this function doesn't exit until anything -interesting (success, error or timeout) happens. Furthermore, it -only exits locally (returning the JSONRPC result object) if the -request is successful, otherwise exit non-locally with an error -of type `jsonrpc-error'. +but synchronous. -DEFERRED is passed to `jsonrpc-async-request', which see." +Except in the case of a non-nil CANCEL-ON-INPUT (explained +below), this function doesn't exit until anything interesting +happens (success reply, error reply, or timeout). Furthermore, +it only exits locally (returning the JSONRPC result object) if +the request is successful, otherwise it exits non-locally with an +error of type `jsonrpc-error'. + +DEFERRED is passed to `jsonrpc-async-request', which see. + +If CANCEL-ON-INPUT is non-nil and the user inputs something while +the functino is waiting, then it exits immediately, returning +CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are +ignored." (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer + cancelled (retval (unwind-protect ; protect against user-quit, for example (catch tag @@ -274,19 +285,27 @@ DEFERRED is passed to `jsonrpc-async-request', which see." id-and-timer (jsonrpc--async-request-1 connection method params - :success-fn (lambda (result) (throw tag `(done ,result))) + :success-fn (lambda (result) + (unless cancelled + (throw tag `(done ,result)))) :error-fn (jsonrpc-lambda (&key code message data) - (throw tag `(error (jsonrpc-error-code . ,code) - (jsonrpc-error-message . ,message) - (jsonrpc-error-data . ,data)))) + (unless cancelled + (throw tag `(error (jsonrpc-error-code . ,code) + (jsonrpc-error-message . ,message) + (jsonrpc-error-data . ,data))))) :timeout-fn (lambda () - (throw tag '(error (jsonrpc-error-message . "Timed out")))) + (unless cancelled + (throw tag '(error (jsonrpc-error-message . "Timed out"))))) :deferred deferred :timeout timeout)) - (while t (accept-process-output nil 30))) + (cond (cancel-on-input + (while (sit-for 30)) + (setq cancelled t) + `(cancelled ,cancel-on-input-retval)) + (t (while t (accept-process-output nil 30))))) (pcase-let* ((`(,id ,timer) id-and-timer)) (remhash id (jsonrpc--request-continuations connection)) (remhash (list deferred (current-buffer)) |