mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-29 19:48:19 +00:00
Code Issues Releases Activity

Synchronous JSONRPC requests can be cancelled on user input

Browse Source 
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.
This commit is contained in:
João Távora 2018-08-09 10:43:41 +01:00
parent 63a8f4cfd7
commit cdafa8933d
1 changed files with 36 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
lisp/jsonrpc.el
View File

@ -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))