branch: externals/eglot
commit 10559a5535fb31369e59dbfe13d2f4e3dc7b0197
Author: João Távora <joaotav...@gmail.com>
Commit: João Távora <joaotav...@gmail.com>
Shuffle definitions around again
---
jsonrpc.el | 279 +++++++++++++++++++++++++++++++++----------------------------
1 file changed, 151 insertions(+), 128 deletions(-)
diff --git a/jsonrpc.el b/jsonrpc.el
index f5808fc..3e0bf8e 100644
--- a/jsonrpc.el
+++ b/jsonrpc.el
@@ -100,33 +100,8 @@
(require 'array) ; xor
-;; Public stuff
-;;
-(defun jsonrpc-error (&rest args)
- "Error out with FORMAT and ARGS.
-If invoked inside a dispatcher function, this function is suitable
-for replying to the remote endpoint with an error message.
-
-ARGS can be of the form (FORMAT-STRING . MOREARGS) for replying
-with a -32603 error code and a message formed by formatting
-FORMAT-STRING with MOREARGS.
-
-Alternatively ARGS can be plist representing a JSONRPC error
-object, using the keywords `:code', `:message' and `:data'."
- (if (stringp (car args))
- (let ((msg
- (apply #'format-message (car args) (cdr args))))
- (signal 'jsonrpc-error
- `(,msg
- (jsonrpc-error-code . ,32603)
- (jsonrpc-error-message . ,msg))))
- (cl-destructuring-bind (&key code message data) args
- (signal 'jsonrpc-error
- `(,(format "[jsonrpc] error ")
- (jsonrpc-error-code . ,code)
- (jsonrpc-error-message . ,message)
- (jsonrpc-error-data . ,data))))))
-
+;;; Public API
+;;;
;;;###autoload
(defclass jsonrpc-connection ()
((name
@@ -180,47 +155,34 @@ arguments (CONN METHOD PARAMS) for handling JSONRPC
notifications. CONN, METHOD and PARAMS are the same as in
:REQUEST-DISPATCHER.")
-;;;###autoload
-(defclass jsonrpc-process-connection (jsonrpc-connection)
- ((-process
- :initarg :process :accessor jsonrpc--process
- :documentation "Process object wrapped by the this connection.")
- (-expected-bytes
- :accessor jsonrpc--expected-bytes
- :documentation "How many bytes declared by server")
- (-on-shutdown
- :accessor jsonrpc--on-shutdown
- :initform #'ignore
- :initarg :on-shutdown
- :documentation "Function run when the process dies."))
- :documentation "A JSONRPC connection over an Emacs process.
-The following initargs are accepted:
+;;; API mandatory
+(cl-defgeneric jsonrpc-connection-send (conn &key id method params result
error)
+ "Send a JSONRPC message to connection CONN.")
-:PROCESS (mandatory), a live running Emacs process object or a
-function of no arguments producing one such object. The process
-represents either a pipe connection to locally running process or
-a stream connection to a network host. The remote endpoint is
-expected to understand JSONRPC messages with basic HTTP-style
-enveloping headers such as \"Content-Length:\".
+;;; API optional
+(cl-defgeneric jsonrpc-shutdown (conn)
+ "Shutdown the JSONRPC connection CONN.")
-:ON-SHUTDOWN (optional), a function of one argument, the
-connection object, called when the process dies .")
+;;; API optional
+(cl-defgeneric jsonrpc-running-p (conn)
+ "Tell if the JSONRPC connection CONN is still running.")
-(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
- (cl-call-next-method)
- (let* ((proc (plist-get slots :process))
- (proc (if (functionp proc) (funcall proc) proc))
- (buffer (get-buffer-create (format "*%s output*" (process-name
proc))))
- (stderr (get-buffer-create (format "*%s stderr*" (process-name
proc)))))
- (setf (jsonrpc--process conn) proc)
- (set-process-buffer proc buffer)
- (process-put proc 'jsonrpc-stderr stderr)
- (set-process-filter proc #'jsonrpc--process-filter)
- (set-process-sentinel proc #'jsonrpc--process-sentinel)
- (with-current-buffer (process-buffer proc)
- (set-marker (process-mark proc) (point-min))
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
- (process-put proc 'jsonrpc-connection conn)))
+;;; API optional
+(cl-defgeneric jsonrpc-connection-ready-p (connection what)
+"Tell if CONNECTION is ready for WHAT in current buffer.
+If it isn't, a deferrable `jsonrpc-async-request' will be
+deferred to the future. By default, all connections are ready
+for sending requests immediately."
+(:method (_s _what) ;; by default all connections are ready
+ t))
+
+
+;;; Convenience
+;;;
+(cl-defmacro jsonrpc-lambda (cl-lambda-list &body body)
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((e (gensym "jsonrpc-lambda-elem")))
+ `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
(defun jsonrpc-events-buffer (connection)
"Get or create JSONRPC events buffer for CONNECTION."
@@ -237,74 +199,37 @@ connection object, called when the process dies .")
buffer))))
buffer))
-(defun jsonrpc-stderr-buffer (connection)
- "Get CONNECTION's stderr buffer, if any."
- (process-get (jsonrpc--process connection) 'jsonrpc-stderr))
-
-(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
- &rest args
- &key
- id
- method
- params
- result
- error)
- "Send MESSAGE, a JSON object, to CONNECTION."
- (let* ((method
- (cond ((keywordp method)
- (substring (symbol-name method) 1))
- ((and method (symbolp method)) (symbol-name method))
- (t method)))
- (message `(:jsonrpc "2.0"
- ,@(when method `(:method ,method))
- ,@(when id `(:id ,id))
- ,@(when params `(:params ,params))
- ,@(when result `(:result ,result))
- ,@(when error `(:error ,error))))
- (json (jsonrpc--json-encode message)))
- (process-send-string (jsonrpc--process connection)
- (format "Content-Length: %d\r\n\r\n%s"
- (string-bytes json)
- json))
- (jsonrpc--log-event connection message 'client)))
-
-(cl-defmethod jsonrpc-process-type ((conn jsonrpc-process-connection))
- "Return the process-type of JSONRPC connection CONN"
- (let ((proc (jsonrpc--process conn))) (and (process-live-p proc) proc)))
-
-(cl-defmethod jsonrpc-running-p ((conn jsonrpc-process-connection))
- "Return non-nil if JSONRPC connection CONN is running."
- (process-live-p (jsonrpc--process conn)))
-
-(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection))
- "Shutdown the JSONRPC connection CONN."
- (cl-loop
- with proc = (jsonrpc--process conn)
- do
- (delete-process proc)
- (accept-process-output nil 0.1)
- while (not (process-get proc 'jsonrpc-sentinel-done))
- do (jsonrpc--warn
- "Sentinel for %s still hasn't run, deleting it!" proc)))
-
(defun jsonrpc-forget-pending-continuations (connection)
"Stop waiting for responses from the current JSONRPC CONNECTION."
(clrhash (jsonrpc--request-continuations connection)))
-(cl-defgeneric jsonrpc-connection-ready-p (connection what) ;; API
- "Tell if CONNECTION is ready for WHAT in current buffer.
-If it isn't, a deferrable `jsonrpc-async-request' will be
-deferred to the future. By default, all connections are ready
-for sending requests immediately."
- (:method (_s _what) t)) ; by default all connections are ready
+
+;;; Contacting the remote endpoint
+;;;
+(defun jsonrpc-error (&rest args)
+ "Error out with FORMAT and ARGS.
+If invoked inside a dispatcher function, this function is suitable
+for replying to the remote endpoint with an error message.
-(cl-defmacro jsonrpc-lambda (cl-lambda-list &body body)
- (declare (indent 1) (debug (sexp &rest form)))
- (let ((e (gensym "jsonrpc-lambda-elem")))
- `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
+ARGS can be of the form (FORMAT-STRING . MOREARGS) for replying
+with a -32603 error code and a message formed by formatting
+FORMAT-STRING with MOREARGS.
-(defconst jrpc-default-request-timeout 10
- "Time in seconds before timing out a JSONRPC request.")
+Alternatively ARGS can be plist representing a JSONRPC error
+object, using the keywords `:code', `:message' and `:data'."
+ (if (stringp (car args))
+ (let ((msg
+ (apply #'format-message (car args) (cdr args))))
+ (signal 'jsonrpc-error
+ `(,msg
+ (jsonrpc-error-code . ,32603)
+ (jsonrpc-error-message . ,msg))))
+ (cl-destructuring-bind (&key code message data) args
+ (signal 'jsonrpc-error
+ `(,(format "[jsonrpc] error ")
+ (jsonrpc-error-code . ,code)
+ (jsonrpc-error-message . ,message)
+ (jsonrpc-error-data . ,data))))))
(cl-defun jsonrpc-async-request (connection
method
@@ -380,11 +305,109 @@ DEFERRED is passed to `jsonrpc-async-request', which
see."
(cadr retval)))
(cl-defun jsonrpc-notify (connection method params)
- "Notify CONNECTION of something, don't expect a reply.e"
+ "Notify CONNECTION of something, don't expect a reply."
(jsonrpc-connection-send connection
:method method
:params params))
+(defconst jrpc-default-request-timeout 10
+ "Time in seconds before timing out a JSONRPC request.")
+
+
+;;; Specfic to `jsonrpc-process-connection'
+;;;
+;;;###autoload
+(defclass jsonrpc-process-connection (jsonrpc-connection)
+ ((-process
+ :initarg :process :accessor jsonrpc--process
+ :documentation "Process object wrapped by the this connection.")
+ (-expected-bytes
+ :accessor jsonrpc--expected-bytes
+ :documentation "How many bytes declared by server")
+ (-on-shutdown
+ :accessor jsonrpc--on-shutdown
+ :initform #'ignore
+ :initarg :on-shutdown
+ :documentation "Function run when the process dies."))
+ :documentation "A JSONRPC connection over an Emacs process.
+The following initargs are accepted:
+
+:PROCESS (mandatory), a live running Emacs process object or a
+function of no arguments producing one such object. The process
+represents either a pipe connection to locally running process or
+a stream connection to a network host. The remote endpoint is
+expected to understand JSONRPC messages with basic HTTP-style
+enveloping headers such as \"Content-Length:\".
+
+:ON-SHUTDOWN (optional), a function of one argument, the
+connection object, called when the process dies .")
+
+(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
+ (cl-call-next-method)
+ (let* ((proc (plist-get slots :process))
+ (proc (if (functionp proc) (funcall proc) proc))
+ (buffer (get-buffer-create (format "*%s output*" (process-name
proc))))
+ (stderr (get-buffer-create (format "*%s stderr*" (process-name
proc)))))
+ (setf (jsonrpc--process conn) proc)
+ (set-process-buffer proc buffer)
+ (process-put proc 'jsonrpc-stderr stderr)
+ (set-process-filter proc #'jsonrpc--process-filter)
+ (set-process-sentinel proc #'jsonrpc--process-sentinel)
+ (with-current-buffer (process-buffer proc)
+ (set-marker (process-mark proc) (point-min))
+ (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
+ (process-put proc 'jsonrpc-connection conn)))
+
+(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
+ &rest args
+ &key
+ id
+ method
+ params
+ result
+ error)
+ "Send MESSAGE, a JSON object, to CONNECTION."
+ (let* ((method
+ (cond ((keywordp method)
+ (substring (symbol-name method) 1))
+ ((and method (symbolp method)) (symbol-name method))
+ (t method)))
+ (message `(:jsonrpc "2.0"
+ ,@(when method `(:method ,method))
+ ,@(when id `(:id ,id))
+ ,@(when params `(:params ,params))
+ ,@(when result `(:result ,result))
+ ,@(when error `(:error ,error))))
+ (json (jsonrpc--json-encode message)))
+ (process-send-string (jsonrpc--process connection)
+ (format "Content-Length: %d\r\n\r\n%s"
+ (string-bytes json)
+ json))
+ (jsonrpc--log-event connection message 'client)))
+
+(defun jsonrpc-process-type (conn)
+ "Return the `process-type' of JSONRPC connection CONN."
+ (let ((proc (jsonrpc--process conn))) (and (process-live-p proc) proc)))
+
+(cl-defmethod jsonrpc-running-p ((conn jsonrpc-process-connection))
+ "Return non-nil if JSONRPC connection CONN is running."
+ (process-live-p (jsonrpc--process conn)))
+
+(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection))
+ "Shutdown the JSONRPC connection CONN."
+ (cl-loop
+ with proc = (jsonrpc--process conn)
+ do
+ (delete-process proc)
+ (accept-process-output nil 0.1)
+ while (not (process-get proc 'jsonrpc-sentinel-done))
+ do (jsonrpc--warn
+ "Sentinel for %s still hasn't run, deleting it!" proc)))
+
+(defun jsonrpc-stderr-buffer (conn)
+ "Get CONNECTION's stderr buffer, if any."
+ (process-get (jsonrpc--process conn) 'jsonrpc-stderr))
+
;;; Private stuff
;;;
