emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/eglot 0e44b27 27/69: jsonrpc.el uses classes and generi


From: João Távora
Subject: [elpa] externals/eglot 0e44b27 27/69: jsonrpc.el uses classes and generic functions
Date: Fri, 22 Jun 2018 11:54:58 -0400 (EDT)

branch: externals/eglot
commit 0e44b27b6b5a9b2c29ce2ff685b09e28954a4296
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    jsonrpc.el uses classes and generic functions
    
    * jsonrpc.el: Rework commentary.
    (jsonrpc-find-connection-functions, jsonrpc-current-connection)
    (jsonrpc-current-connection-or-lose): Rename from old
    process-based counterpart.
    (jsonrpc-connection, jsonrpc-process-connection): New classes
    (jsonrpc-define-process-var): Delete.
    (jsonrpc--make-process-connection): Rework from old
    jsonrpc--make-process.
    (jsonrpc-connect): Rework.
    (jsonrpc--process-sentinel): Rework.
    (jsonrpc--process-filter): Rework.
    (jsonrpc-events-buffer, jsonrpc-log-event): Take a connection.
    (jsonrpc--connection-receive): Rename from old process-based
    conterpart.
    (jsonrpc-connection-send): Rename from old process-based
    conterpart.  Now a generic function.
    (jsonrpc-forget-pending-continuations)
    (jsonrpc-clear-status, jsonrpc--call-deferred): Take a connection.
    (jsonrpc-connection-ready-p): New generic function.
    (jsonrpc-async-request, jsonrpc--async-request-1): Take a
    connection. Rework.
    (jsonrpc-request, jsonrpc-notify, jsonrpc-reply): Take a
    connection.
---
 jsonrpc.el | 450 ++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 233 insertions(+), 217 deletions(-)

diff --git a/jsonrpc.el b/jsonrpc.el
index 35516d0..a380b7a 100644
--- a/jsonrpc.el
+++ b/jsonrpc.el
@@ -33,20 +33,28 @@
 ;; concepts can be used within the same process, over sockets, over
 ;; http, or in many various message passing environments."
 ;;
-;; To approach this agnosticism, jsonrpc.el uses Emacs's "process"
-;; abstraction since it mostly hides the underlying differences
-;; between local subprocesses and network endpoints.  Thus everywhere
-;; in this library (be it in the internals or in the user-visible
-;; protocol), JSONRPC endpoint is an (augmented) process object.
+;; To approach this agnosticism, jsonrpc.el uses objects derived from
+;; an abstract class, `jsonrpc-connection' to represent the connection
+;; to the remote JSON endpoint.  Abstract operations such as sending
+;; and receiving are modelled as generic functions, so that users of
+;; JSONRPC working in complicated transport infrastructures can
+;; specify a subclass of `jsonrpc-connection' and write specific
+;; methods for it.  Nevertheless, jsonrpc.el comes built-in with
+;; `jsonrpc-process-connection' class that works both with local
+;; subprocesses (through stdin/stdout) and TCP hosts (using
+;; sockets). This uses some simple HTTP-style envelopping for JSON
+;; objects travelling through the wire.
 ;;
-;; The main entry point is `jsonrpc-connect'.  It is passed a name
-;; identifying the connection and a "contact", which will determine
-;; the connection type to make.  It can a list of strings (a command
-;; and arguments for creating subprocesses) or a (HOST PORT-NUMBER
-;; PARAMS...) for connecting via TCP.  For flexibility, it can also be
-;; a pre-connected process.
+;; Thus, the main entry point `jsonrpc-connect', returns one of these
+;; objects by default.  It is passed a name identifying the connection
+;; and a "contact", which will determine the connection type to make.
+;; This contact can a list of strings (a command and arguments for
+;; creating subprocesses) or a list of the form (HOST PORT-NUMBER
+;; PARAMS...)  for connecting via TCP.  For the providing the
+;; aforementioned flexibility, it can also be a any object of a
+;; subclass of `jsonrpc-connection'.
 ;;
-;; `jsonrpc-connect' returns a process upon connection.  This value
+;; `jsonrpc-connect' returns a connection upon connection.  This value
 ;; should be saved to be later given to `jsonrpc-notify',
 ;; `jsonrpc-reply', `jsonrpc-request' and `jsonrpc-async-request' as a
 ;; way of contacting the connected remote endpoint.
@@ -90,17 +98,17 @@
 ;;          :log (lambda (_server client _message)
 ;;                 (jsonrpc-connect
 ;;                  (process-name client) client
-;;                  (lambda (proc method id params)
+;;                  (lambda (endpoint method id params)
 ;;                    (unless (memq method server-allowed-functions)
 ;;                      (signal 'jsonrpc-error `((jsonrpc-error-message
 ;;                                                . "Sorry, this isn't 
allowed")
-;;                                               (jsonrpc-error-code . 
32601))))
-;;                    (jsonrpc-reply proc id :result
+;;                                               (jsonrpc-error-code . 
-32601))))
+;;                    (jsonrpc-reply endpoint id :result
 ;;                                   (apply method (append params nil))))))))
 
 ;;   (setq server-endpoint (jsonrpc-connect
 ;;                          "Emacs RPC client" '("localhost" 9393)
-;;                          (lambda (_proc method id &rest params)
+;;                          (lambda (endpoint method id &rest params)
 ;;                            (message "server wants to %s" method))))
 ;;
 ;;   ;; returns 3
@@ -120,22 +128,23 @@
 
 (require 'cl-lib)
 (require 'json)
+(require 'eieio)
 (require 'subr-x)
 (require 'warnings)
 (require 'pcase)
 (require 'array) ; xor
 
-(defvar jsonrpc-find-process-functions nil
-  "Special hook to find an active JSON-RPC process.")
+(defvar jsonrpc-find-connection-functions nil
+  "Special hook to find an active JSON-RPC connection.")
 
-(defun jsonrpc-current-process ()
-  "The current logical JSON-RPC process."
-  (run-hook-with-args-until-success 'jsonrpc-find-process-functions))
+(defun jsonrpc-current-connection ()
+  "The current logical JSON-RPC connection."
+  (run-hook-with-args-until-success 'jsonrpc-find-connection-functions))
 
-(defun jsonrpc-current-process-or-lose ()
-  "Return the current JSON-RPC process or error."
-  (or (jsonrpc-current-process)
-      (jsonrpc-error "No current JSON-RPC process")))
+(defun jsonrpc-current-connection-or-lose ()
+  "Return the current JSON-RPC connection or error."
+  (or (jsonrpc-current-connection)
+      (jsonrpc-error "No current JSON-RPC connection")))
 
 (define-error 'jsonrpc-error "jsonrpc-error")
 
@@ -159,70 +168,43 @@ FORMAT as the message."
                      (apply #'format format args)
                      :warning)))
 
-(defmacro jsonrpc-define-process-var
-    (var-sym initval &optional doc)
-  "Define VAR-SYM as a generalized process-local variable.
-INITVAL is the default value.  DOC is the documentation."
-  (declare (indent 2) (doc-string 3))
-  `(progn
-     (defun ,var-sym (proc) ,doc
-       (let* ((plist (process-plist proc))
-              (probe (plist-member plist ',var-sym)))
-         (if probe (cadr probe)
-           (let ((def ,initval)) (process-put proc ',var-sym def) def))))
-     (gv-define-setter ,var-sym (to-store process)
-       `(let ((once ,to-store)) (process-put ,process ',',var-sym once) 
once))))
-
-(jsonrpc-define-process-var jsonrpc-name nil
-  "A name for the process")
-
-(jsonrpc-define-process-var jsonrpc--dispatcher nil
-  "Emacs-lisp function for server-invoked methods.")
-
-(jsonrpc-define-process-var jsonrpc-status `(:unknown nil)
-  "Status as declared by the server.
+(defclass jsonrpc-connection ()
+  ((name :accessor jsonrpc-name
+         :documentation "A name for the connection")
+   (-dispatcher :accessor jsonrpc--dispatcher
+                :documentation "Emacs-lisp function for server-invoked 
methods.")
+   (status :initform `(:unknown nil) :accessor jsonrpc-status
+           :documentation "Status as declared by the server.
 A list (WHAT SERIOUS-P).")
-
-(jsonrpc-define-process-var jsonrpc--expected-bytes nil
-  "How many bytes declared by server")
-
-(jsonrpc-define-process-var jsonrpc--request-continuations (make-hash-table)
-  "A hash table of request ID to continuation lambdas.")
-
-(jsonrpc-define-process-var jsonrpc--server-request-ids nil
-  "Server-initiated request id that client hasn't replied to.")
-
-(jsonrpc-define-process-var jsonrpc--events-buffer nil
-  "A buffer pretty-printing the JSON-RPC RPC events")
-
-(jsonrpc-define-process-var jsonrpc-contact nil
-  "Method used to contact a server.")
-
-(jsonrpc-define-process-var jsonrpc--on-shutdown nil
-  "Function run when JSONRPC server is dying.
-Run after running any error handlers for outstanding requests.
-A function passed the process object for the server.")
-
-(jsonrpc-define-process-var jsonrpc--deferred-actions
-    (make-hash-table :test #'equal)
-  "Actions deferred to when server is thought to be ready.")
-
-(defun jsonrpc-outstanding-request-ids (proc)
-  "IDs of outstanding JSONRPC requests for PROC."
-  (hash-table-keys (jsonrpc--request-continuations proc)))
-
-(defun jsonrpc--make-process (name contact)
-  "Make a process from CONTACT.
-NAME is a name to give the inferior process or connection.
-CONTACT is as explained in `jsonrpc-connect'.  Returns a process
-object."
+   (-request-continuations :initform (make-hash-table)
+                           :accessor jsonrpc--request-continuations
+                           :documentation "A hash table of request ID to 
continuation lambdas.")
+   (-server-request-ids :accessor jsonrpc--server-request-ids
+                        :documentation "Server-initiated request id that 
client hasn't replied to.")
+   (-events-buffer :accessor jsonrpc--events-buffer
+                   :documentation "A buffer pretty-printing the JSON-RPC RPC 
events")
+   (contact :accessor jsonrpc-contact
+            :documentation "Method used to contact a server.")
+   (-on-shutdown :accessor jsonrpc--on-shutdown :documentation
+                 "Function run when JSONRPC server is dying.")
+   (-deferred-actions :initform (make-hash-table :test #'equal)
+                      :accessor jsonrpc--deferred-actions
+                      :documentation "Actions deferred to when server is 
thought to be ready.")))
+
+(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")))
+
+(defun jsonrpc--make-process-connection (name contact)
+  "Make a `jsonrpc-process-connection' from NAME and CONTACT."
   (let* ((readable-name (format "JSON-RPC server (%s)" name)                   
                                         )
-         (buffer (get-buffer-create (format "*%s stderr*" readable-name)))
+         (buffer (get-buffer-create (format "*%s output*" readable-name)))
          (proc
           (cond ((processp contact) contact)
                 ((integerp (cadr contact))
-                 (apply #'open-network-stream
-                        readable-name buffer contact))
+                 (apply #'open-network-stream readable-name buffer contact))
                 (t
                  (make-process :name readable-name
                                :command contact
@@ -234,7 +216,11 @@ object."
     (set-marker (process-mark proc) (with-current-buffer buffer (point-min)))
     (set-process-filter proc #'jsonrpc--process-filter)
     (set-process-sentinel proc #'jsonrpc--process-sentinel)
-    proc))
+    (with-current-buffer buffer
+      (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
+    (let ((connection (make-instance 'jsonrpc-process-connection :process 
proc)))
+      (prog1 connection
+        (process-put proc 'jsonrpc-connection connection)))))
 
 (defmacro jsonrpc-obj (&rest what)
   "Make WHAT a suitable argument for `json-encode'."
@@ -245,25 +231,33 @@ object."
 
 ;;;###autoload
 (cl-defun jsonrpc-connect (name contact dispatcher &optional on-shutdown)
-  "Connect to JSON-RPC server hereafter known as NAME through CONTACT.
+  "Connect to JSONRPC endpoint hereafter known as NAME through CONTACT.
+
+NAME is a string naming the connection.
+
+CONTACT specifies how to connect. In the most generic case, it is
+a symbol naming a subclass of `jsonrpc-connection' or a
+previously created object of this type.
 
-NAME is a string naming the server.
+However, for convenience, and when working with
+socket-and-stdio-based JSONRPC connections, it can also be a list
+of strings (COMMAND ARGS...) specifying how to start a server
+subconnection to connect to. Moreover, if the second element in
+the list is an integer number instead of a string, the list is
+interpreted as (HOST PORT PARAMETERS...) and a TCP connection is
+attempted to HOST on PORT, with the remaining PARAMETERS are
+given to `open-network-stream's optional arguments.
 
-CONTACT is a list of strings (COMMAND ARGS...) specifying how to
-start a server subprocess to connect to.  If the second element
-in the list is an integer number instead of a string, the list is
-interpreted as (HOST PORT PARAMETERS...) to connect to an
-existing server via TCP, with the remaining PARAMETERS are given
-to `open-network-stream's optional arguments.  CONTACT can also
-be a live connected process object. In that case its buffer,
-filter and sentinel are overwritten by `jsonrpc-connect'.
+CONTACT can also be a live connected process object. In that
+case its buffer, filter and sentinel are overwritten by
+`jsonrpc-connect'.
 
 ON-SHUTDOWN, if non-nil, is a function called on server exit and
-passed the moribund process object as a single argument.
+passed the moribund connection object as a single argument.
 
 DISPATCHER specifies how the server-invoked methods find their
 Elisp counterpart. It is a function passed (PROC METHOD ID PARAMS
-as arguments. PROC is the process object returned by this
+as arguments. PROC is the connection object returned by this
 function. ID is the server identifier for a server request, or
 nil for a server notification. METHOD is a symbol. PARAMS
 contains the method parameters as JSON data.
@@ -275,43 +269,55 @@ signals an error with alist elements 
`jsonrpc-error-message' and
 `jsonrpc-error-code' in its DATA, the corresponding elements are
 used for the automated error reply.
 
-`jsonrpc-connect' returns a process object representing the server."
-  (let* ((proc (jsonrpc--make-process name contact)))
-    (setf (jsonrpc-contact proc) contact
-          (jsonrpc-name proc) name
-          (jsonrpc--dispatcher proc) dispatcher
-          (jsonrpc--on-shutdown proc) on-shutdown)
-    (with-current-buffer (process-buffer proc)
-      (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))))
+If successful, `jsonrpc-connect' returns a `jsonrpc-connection'
+object representing the remote endpoint."
+  (let* ((connection
+          (cond ((cl-typep contact 'jsonrpc-connection)
+                 contact)
+                ((symbolp contact)
+                 (make-instance contact))
+                ((or (listp contact) (processp contact))
+                 (jsonrpc--make-process-connection name contact)))))
+    (setf (jsonrpc-contact connection) contact
+          (jsonrpc-name connection) name
+          (jsonrpc--dispatcher connection) dispatcher
+          (jsonrpc--on-shutdown connection) (or on-shutdown #'ignore))
+    connection))
 
 (defun jsonrpc--process-sentinel (proc change)
   "Called when PROC undergoes CHANGE."
-  (jsonrpc-log-event proc `(:message "Process state changed" :change ,change))
-  (when (not (process-live-p proc))
-    (with-current-buffer (jsonrpc-events-buffer proc)
-      (let ((inhibit-read-only t))
-        (insert "\n----------b---y---e---b---y---e----------\n")))
-    ;; Cancel outstanding timers
-    (maphash (lambda (_id triplet)
-               (pcase-let ((`(,_success ,_error ,timeout) triplet))
-                 (when timeout (cancel-timer timeout))))
-             (jsonrpc--request-continuations proc))
-    (unwind-protect
-        ;; Call all outstanding error handlers
-        (maphash (lambda (_id triplet)
-                   (pcase-let ((`(,_success ,error ,_timeout) triplet))
-                     (funcall error `(:code -1 :message "Server died"))))
-                 (jsonrpc--request-continuations proc))
-      (jsonrpc-message "Server exited with status %s" (process-exit-status 
proc))
-      (funcall (or (jsonrpc--on-shutdown proc) #'ignore) proc)
-      (delete-process proc))))
+  (let ((connection (process-get proc 'jsonrpc-connection)))
+    (jsonrpc-log-event connection `(:message "Connection state changed" 
:change ,change))
+    (when (not (process-live-p proc))
+      (with-current-buffer (jsonrpc-events-buffer connection)
+        (let ((inhibit-read-only t))
+          (insert "\n----------b---y---e---b---y---e----------\n")))
+      ;; Cancel outstanding timers
+      (maphash (lambda (_id triplet)
+                 (pcase-let ((`(,_success ,_error ,timeout) triplet))
+                   (when timeout (cancel-timer timeout))))
+               (jsonrpc--request-continuations connection))
+      (unwind-protect
+          ;; Call all outstanding error handlers
+          (maphash (lambda (_id triplet)
+                     (pcase-let ((`(,_success ,error ,_timeout) triplet))
+                       (funcall error `(:code -1 :message "Server died"))))
+                   (jsonrpc--request-continuations connection))
+        (jsonrpc-message "Server exited with status %s" (process-exit-status 
proc))
+        (unwind-protect
+            (funcall (jsonrpc--on-shutdown connection) proc))
+        (when (process-live-p proc)
+          (jsonrpc-warn "Brutally deleting non-compliant %s"
+                        (jsonrpc-name connection))
+          (delete-process proc))))))
 
 (defun jsonrpc--process-filter (proc string)
   "Called when new data STRING has arrived for PROC."
   (when (buffer-live-p (process-buffer proc))
     (with-current-buffer (process-buffer proc)
-      (let ((inhibit-read-only t)
-            (expected-bytes (jsonrpc--expected-bytes proc)))
+      (let* ((inhibit-read-only t)
+             (connection (process-get proc 'jsonrpc-connection))
+             (expected-bytes (jsonrpc--expected-bytes connection)))
         ;; Insert the text, advancing the process marker.
         ;;
         (save-excursion
@@ -363,8 +369,8 @@ used for the automated error reply.
                                   ;; buffer, shielding proc buffer from
                                   ;; tamper
                                   (with-temp-buffer
-                                    (jsonrpc--process-receive proc
-                                                              json-message)))))
+                                    (jsonrpc--connection-receive connection
+                                                                 
json-message)))))
                           (goto-char message-end)
                           (delete-region (point-min) (point))
                           (setq expected-bytes nil))))
@@ -374,31 +380,32 @@ used for the automated error reply.
                       (setq done 
:waiting-for-more-bytes-in-this-message))))))))
           ;; Saved parsing state for next visit to this filter
           ;;
-          (setf (jsonrpc--expected-bytes proc) expected-bytes))))))
+          (setf (jsonrpc--expected-bytes connection) expected-bytes))))))
 
-(defun jsonrpc-events-buffer (process &optional interactive)
-  "Display events buffer for current JSONRPC connection PROCESS.
+(defun jsonrpc-events-buffer (connection &optional interactive)
+  "Display events buffer for current JSONRPC connection CONNECTION.
 INTERACTIVE is t if called interactively."
-  (interactive (list (jsonrpc-current-process-or-lose) t))
-  (let* ((probe (jsonrpc--events-buffer process))
+  (interactive (list (jsonrpc-current-connection-or-lose) t))
+  (let* ((probe (jsonrpc--events-buffer connection))
          (buffer (or (and (buffer-live-p probe)
                           probe)
                      (let ((buffer (get-buffer-create
                                     (format "*%s events*"
-                                            (process-name process)))))
+                                            (jsonrpc-name connection)))))
                        (with-current-buffer buffer
                          (buffer-disable-undo)
                          (read-only-mode t)
-                         (setf (jsonrpc--events-buffer process) buffer))
+                         (setf (jsonrpc--events-buffer connection) buffer))
                        buffer))))
     (when interactive (display-buffer buffer))
     buffer))
 
-(defun jsonrpc-log-event (proc message &optional type)
+(defun jsonrpc-log-event (connection message &optional type)
   "Log an jsonrpc-related event.
-PROC is the current process.  MESSAGE is a JSON-like plist.  TYPE
-is a symbol saying if this is a client or server originated."
-  (with-current-buffer (jsonrpc-events-buffer proc)
+CONNECTION is the current connection.  MESSAGE is a JSON-like
+plist.  TYPE is a symbol saying if this is a client or server
+originated."
+  (with-current-buffer (jsonrpc-events-buffer connection)
     (cl-destructuring-bind (&key method id error &allow-other-keys) message
       (let* ((inhibit-read-only t)
              (subtype (cond ((and method id)       'request)
@@ -417,8 +424,8 @@ is a symbol saying if this is a client or server 
originated."
             (setq msg (propertize msg 'face 'error)))
           (insert-before-markers msg))))))
 
-(defun jsonrpc--process-receive (proc message)
-  "Process MESSAGE from PROC."
+(defun jsonrpc--connection-receive (connection message)
+  "Connection MESSAGE from CONNECTION."
   (pcase-let ((`(,method ,id ,error ,params ,result)
                (condition-case-unless-debug oops
                    (cl-destructuring-bind
@@ -429,43 +436,49 @@ is a symbol saying if this is a client or server 
originated."
                         nil)))
               (continuations)
               (lisp-err))
-    (jsonrpc-log-event proc message 'server)
-    (when error (setf (jsonrpc-status proc) `(,error t)))
+    (jsonrpc-log-event connection message 'server)
+    (when error (setf (jsonrpc-status connection) `(,error t)))
     (cond (method
-           (condition-case-unless-debug oops
-               (funcall (jsonrpc--dispatcher proc) proc (intern method) id 
params)
-             (error (setq lisp-err oops)))
-           (unless (or (member id (jsonrpc--server-request-ids proc))
+           (let ((debug-on-error
+                  (and debug-on-error
+                       (not (ert-running-test)))))
+             (condition-case-unless-debug oops
+                 (funcall (jsonrpc--dispatcher connection)
+                          connection (intern method) id params)
+               (error (setq lisp-err oops))))
+           (unless (or (member id (jsonrpc--server-request-ids connection))
                        (not (or id lisp-err)))
              (jsonrpc-reply
-              proc id
+              connection id
               :error (jsonrpc-obj
                       :code (or (alist-get 'jsonrpc-error-code (cdr lisp-err))
                                 -32603)
                       :message (or (alist-get 'jsonrpc-error-message
                                               (cdr lisp-err))
                                    "Internal error"))))
-           (setf (jsonrpc--server-request-ids proc)
-                 (delete id (jsonrpc--server-request-ids proc))))
+           (setf (jsonrpc--server-request-ids connection)
+                 (delete id (jsonrpc--server-request-ids connection))))
           ((setq continuations
-                 (and id (gethash id (jsonrpc--request-continuations proc))))
+                 (and id (gethash id (jsonrpc--request-continuations 
connection))))
            (let ((timer (nth 2 continuations)))
              (when timer (cancel-timer timer)))
-           (remhash id (jsonrpc--request-continuations proc))
+           (remhash id (jsonrpc--request-continuations connection))
            (if error (funcall (nth 1 continuations) error)
              (funcall (nth 0 continuations) result)))
           (id
            (jsonrpc-warn "No continuation for id %s" id)))
-    (jsonrpc--call-deferred proc)))
+    (jsonrpc--call-deferred connection)))
 
-(defun jsonrpc--process-send (proc message)
-  "Send MESSAGE to PROC (ID is optional)."
+(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
+                                       message)
+  "Send MESSAGE, a JSON object, to CONNECTION."
   (let ((json-object-type 'plist)
         (json (json-encode message)))
-    (process-send-string proc (format "Content-Length: %d\r\n\r\n%s"
-                                      (string-bytes json)
-                                      json))
-    (jsonrpc-log-event proc message 'client)))
+    (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)))
 
 (defvar jsonrpc--next-request-id 0)
 
@@ -473,27 +486,28 @@ is a symbol saying if this is a client or server 
originated."
   "Compute the next id for a client request."
   (setq jsonrpc--next-request-id (1+ jsonrpc--next-request-id)))
 
-(defun jsonrpc-forget-pending-continuations (proc)
-  "Stop waiting for responses from the current JSONRPC PROC."
-  (interactive (list (jsonrpc-current-process-or-lose)))
-  (clrhash (jsonrpc--request-continuations proc)))
+(defun jsonrpc-forget-pending-continuations (connection)
+  "Stop waiting for responses from the current JSONRPC CONNECTION."
+  (interactive (list (jsonrpc-current-connection-or-lose)))
+  (clrhash (jsonrpc--request-continuations connection)))
 
-(defun jsonrpc-clear-status (process)
-  "Clear most recent error message from PROCESS."
-  (interactive (list (jsonrpc-current-process-or-lose)))
-  (setf (jsonrpc-status process) nil))
+(defun jsonrpc-clear-status (connection)
+  "Clear most recent error message from CONNECTION."
+  (interactive (list (jsonrpc-current-connection-or-lose)))
+  (setf (jsonrpc-status connection) nil))
 
-(defun jsonrpc--call-deferred (proc)
-  "Call PROC's deferred actions, who may again defer themselves."
-  (when-let ((actions (hash-table-values (jsonrpc--deferred-actions proc))))
-    (jsonrpc-log-event proc `(:running-deferred ,(length actions)))
+(defun jsonrpc--call-deferred (connection)
+  "Call CONNECTION's deferred actions, who may again defer themselves."
+  (when-let ((actions (hash-table-values (jsonrpc--deferred-actions 
connection))))
+    (jsonrpc-log-event connection `(:running-deferred ,(length actions)))
     (mapc #'funcall (mapcar #'car actions))))
 
-(defvar jsonrpc-ready-predicates '()
-  "Special hook of predicates controlling deferred actions.
-If one of these returns nil, a deferrable `jsonrpc-async-request'
-will be deferred.  Each predicate is passed the symbol for the
-request and a process object.")
+(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
 
 (cl-defmacro jsonrpc-lambda (cl-lambda-list &body body)
   (declare (indent 1) (debug (sexp &rest form)))
@@ -503,14 +517,14 @@ request and a process object.")
 (defconst jrpc-default-request-timeout 10
   "Time in seconds before timing out a JSONRPC request.")
 
-(cl-defun jsonrpc-async-request (proc
+(cl-defun jsonrpc-async-request (connection
                                  method
                                  params
                                  &rest args
                                  &key _success-fn _error-fn
                                  _timeout-fn
                                  _timeout _deferred)
-  "Make a request to PROC, expecting a reply, return immediately.
+  "Make a request to CONNECTION, expecting a reply, return immediately.
 The JSONRPC request is formed by METHOD, a symbol, and PARAMS a
 JSON object.
 
@@ -530,9 +544,10 @@ request with identical DEFERRED and for the same buffer.
 However, in that situation, the original timeout is kept.
 
 Returns nil."
-  (apply #'jsonrpc--async-request-1 proc method params args))
+  (apply #'jsonrpc--async-request-1 connection method params args)
+  nil)
 
-(cl-defun jsonrpc--async-request-1 (proc
+(cl-defun jsonrpc--async-request-1 (connection
                                     method
                                     params
                                     &rest args
@@ -553,57 +568,58 @@ TIMEOUT is nil)."
                   (run-with-timer
                    timeout nil
                    (lambda ()
-                     (remhash id (jsonrpc--request-continuations proc))
+                     (remhash id (jsonrpc--request-continuations connection))
                      (funcall (or timeout-fn
                                   (lambda ()
                                     (jsonrpc-log-event
-                                     proc `(:timed-out ,method :id ,id
-                                                       :params 
,params))))))))))))
+                                     connection `(:timed-out ,method :id ,id
+                                                             :params 
,params))))))))))))
     (when deferred
       (let* ((buf (current-buffer))
              (existing (gethash (list deferred buf)
-                                (jsonrpc--deferred-actions proc))))
+                                (jsonrpc--deferred-actions connection))))
         (when existing (setq timer (cadr existing)))
-        (if (run-hook-with-args-until-failure 'jsonrpc-ready-predicates
-                                              deferred proc)
-            (remhash (list deferred buf) (jsonrpc--deferred-actions proc))
-          (jsonrpc-log-event proc `(:deferring ,method :id ,id :params 
,params))
+        (if (jsonrpc-connection-ready-p connection deferred)
+            (remhash (list deferred buf) (jsonrpc--deferred-actions 
connection))
+          (jsonrpc-log-event connection `(:deferring ,method :id ,id :params
+                                                     ,params))
           (let* ((buf (current-buffer)) (point (point))
                  (later (lambda ()
                           (when (buffer-live-p buf)
                             (with-current-buffer buf
                               (save-excursion (goto-char point)
-                                              (apply #'jsonrpc-async-request 
proc
+                                              (apply #'jsonrpc-async-request
+                                                     connection
                                                      method params args)))))))
             (puthash (list deferred buf)
                      (list later (setq timer (funcall make-timer)))
-                     (jsonrpc--deferred-actions proc))
+                     (jsonrpc--deferred-actions connection))
             ;; Non-local exit!
-            (cl-return-from jsonrpc-async-request (list nil timer))))))
+            (cl-return-from jsonrpc-async-request-1 (list nil timer))))))
     ;; Really send it
     ;;
-    (jsonrpc--process-send proc (jsonrpc-obj :jsonrpc "2.0"
-                                             :id id
-                                             :method method
-                                             :params params))
+    (jsonrpc-connection-send connection (jsonrpc-obj :jsonrpc "2.0"
+                                                     :id id
+                                                     :method method
+                                                     :params params))
     (puthash id
              (list (or success-fn
                        (jsonrpc-lambda (&rest _ignored)
                          (jsonrpc-log-event
-                          proc (jsonrpc-obj :message "success ignored" :id 
id))))
+                          connection (jsonrpc-obj :message "success ignored" 
:id id))))
                    (or error-fn
                        (jsonrpc-lambda (&key code message &allow-other-keys)
-                         (setf (jsonrpc-status proc) `(,message t))
+                         (setf (jsonrpc-status connection) `(,message t))
                          (jsonrpc-log-event
-                          proc (jsonrpc-obj :message "error ignored, status 
set"
-                                            :id id :error code))))
+                          connection (jsonrpc-obj :message "error ignored, 
status set"
+                                                  :id id :error code))))
                    (setq timer (funcall make-timer)))
-             (jsonrpc--request-continuations proc))
+             (jsonrpc--request-continuations connection))
     (list id timer)))
 
-(cl-defun jsonrpc-request (proc method params &key deferred timeout)
-  "Make a request to PROC, wait for a reply.
-Like `jsonrpc-async-request' for PROC, METHOD and PARAMS, but
+(cl-defun jsonrpc-request (connection method params &key deferred timeout)
+  "Make a request to CONNECTION, wait for a reply.
+Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, but
 synchronous, i.e. doesn't exit until anything
 interesting (success, error or timeout) happens.  Furthermore,
 only exit locally (and return the JSONRPC result object) if the
@@ -617,7 +633,7 @@ DEFERRED is passed to `jsonrpc-async-request', which see."
                 (setq
                  id-and-timer
                  (jsonrpc--async-request-1
-                  proc method params
+                  connection method params
                   :success-fn (lambda (result) (throw tag `(done ,result)))
                   :error-fn
                   (jsonrpc-lambda
@@ -632,7 +648,7 @@ DEFERRED is passed to `jsonrpc-async-request', which see."
                   :timeout timeout))
                 (while t (accept-process-output nil 30)))
             (pcase-let ((`(,id ,timer) id-and-timer))
-              (when id (remhash id (jsonrpc--request-continuations proc)))
+              (when id (remhash id (jsonrpc--request-continuations 
connection)))
               (when timer (cancel-timer timer))))))
     (when (eq 'error (car retval))
       (signal 'jsonrpc-error
@@ -641,22 +657,22 @@ DEFERRED is passed to `jsonrpc-async-request', which see."
                (cdr retval))))
     (cadr retval)))
 
-(cl-defun jsonrpc-notify (proc method params)
-  "Notify PROC of something, don't expect a reply.e"
-  (jsonrpc--process-send proc (jsonrpc-obj :jsonrpc  "2.0"
-                                           :method method
-                                           :params params)))
+(cl-defun jsonrpc-notify (connection method params)
+  "Notify CONNECTION of something, don't expect a reply.e"
+  (jsonrpc-connection-send connection (jsonrpc-obj :jsonrpc  "2.0"
+                                                   :method method
+                                                   :params params)))
 
-(cl-defun jsonrpc-reply (proc id &key (result nil result-supplied-p) error)
-  "Reply to PROC's request ID with RESULT or ERROR."
+(cl-defun jsonrpc-reply (connection id &key (result nil result-supplied-p) 
error)
+  "Reply to CONNECTION's request ID with RESULT or ERROR."
   (unless id (jsonrpc-error "Need a non-nil ID"))
   (unless (xor result-supplied-p error)
     (jsonrpc-error "Can't pass both RESULT and ERROR!"))
-  (push id (jsonrpc--server-request-ids proc))
-  (jsonrpc--process-send
-   proc `(:jsonrpc  "2.0" :id ,id
-                    ,@(when result `(:result ,result))
-                    ,@(when error `(:error ,error)))))
+  (push id (jsonrpc--server-request-ids connection))
+  (jsonrpc-connection-send
+   connection `(:jsonrpc  "2.0" :id ,id
+                          ,@(when result `(:result ,result))
+                          ,@(when error `(:error ,error)))))
 
 (provide 'jsonrpc)
 ;;; jsonrpc.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]