[elpa] externals/eglot 3265c1d 10/69: Simpler callback protocol for JSONRPC parameters and results

[João Távora]

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

    Simpler callback protocol for JSONRPC parameters and results
    
    Instead of introspecting the :params or :result object to discover if
    an object is present, and changing the Elisp function call type
    (funcall vs apply) accordingly, alway funcall. It's up to the
    application to destructure if it wishes. jrpc-lambda can help with
    that and keep the application code simple.
    
    * eglot.el (eglot--on-shutdown): Fix indentation.
    (eglot--dispatch): Simplify.
    (xref-backend-identifier-completion-table)
    (xref-backend-definitions, xref-backend-references)
    (xref-backend-apropos, eglot-completion-at-point)
    (eglot-eldoc-function, eglot-imenu, eglot--apply-text-edits):
    Don't use jrpc-mapply.
    
    * jrpc.el (jrpc--process-receive): Allow only keys defined in
    JSONRPC2.0
    (jrpc--process-receive): Don't overload function call type based
    on remote response.
    (jrpc-lambda): Return a unary lambda.
    (jrpc-request): Simplify.
    (jrpc-mapply): Remove.
---
 eglot.el | 35 +++++++++++++++++------------------
 jrpc.el  | 32 +++++++++-----------------------
 2 files changed, 26 insertions(+), 41 deletions(-)

diff --git a/eglot.el b/eglot.el
index 4f2e25b..caf2e8c 100644
--- a/eglot.el
+++ b/eglot.el
@@ -128,7 +128,7 @@ A list (ID WHAT DONE-P).")
         (eglot--managed-mode -1))))
   ;; Kill any expensive watches
   (maphash (lambda (_id watches)
-               (mapcar #'file-notify-rm-watch watches))
+             (mapcar #'file-notify-rm-watch watches))
            (eglot--file-watches proc))
   ;; Sever the project/process relationship for proc
   (setf (gethash (eglot--project proc) eglot--processes-by-project)
@@ -314,7 +314,7 @@ INTERACTIVE is t if called interactively."
 
 (defvar eglot-connect-hook nil "Hook run after connecting in 
`eglot--connect'.")
 
-(defun eglot--dispatch (proc method id &rest params)
+(defun eglot--dispatch (proc method id params)
   "Dispatcher passed to `jrpc-connect'.
 Builds a function from METHOD, passes it PROC, ID and PARAMS."
   (let* ((handler-sym (intern (concat "eglot--server-" method))))
@@ -865,7 +865,7 @@ DUMMY is ignored"
       (completion-table-with-cache
        (lambda (string)
          (setq eglot--xref-known-symbols
-               (jrpc-mapply
+               (mapcar
                 (jrpc-lambda (&key name kind location containerName)
                   (propertize name
                               :textDocumentPositionParams
@@ -898,7 +898,7 @@ DUMMY is ignored"
                           :textDocument/definition
                           (get-text-property
                            0 :textDocumentPositionParams identifier)))))
-    (jrpc-mapply
+    (mapcar
      (jrpc-lambda (&key uri range)
        (eglot--xref-make identifier uri (plist-get range :start)))
      location-or-locations)))
@@ -912,7 +912,7 @@ DUMMY is ignored"
                (and rich (get-text-property 0 :textDocumentPositionParams 
rich))))))
     (unless params
       (eglot--error "Don' know where %s is in the workspace!" identifier))
-    (jrpc-mapply
+    (mapcar
      (jrpc-lambda (&key uri range)
        (eglot--xref-make identifier uri (plist-get range :start)))
      (jrpc-request (jrpc-current-process-or-lose)
@@ -924,7 +924,7 @@ DUMMY is ignored"
 
 (cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
   (when (eglot--server-capable :workspaceSymbolProvider)
-    (jrpc-mapply
+    (mapcar
      (jrpc-lambda (&key name location &allow-other-keys)
        (cl-destructuring-bind (&key uri range) location
          (eglot--xref-make name uri (plist-get range :start))))
@@ -947,7 +947,7 @@ DUMMY is ignored"
                                      (eglot--TextDocumentPositionParams)
                                      :textDocument/completion))
                  (items (if (vectorp resp) resp (plist-get resp :items))))
-            (jrpc-mapply
+            (mapcar
              (jrpc-lambda (&rest all &key label &allow-other-keys)
                (add-text-properties 0 1 all label) label)
              items))))
@@ -1040,7 +1040,7 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
         (jrpc-async-request
          proc :textDocument/signatureHelp position-params
          :success-fn (jrpc-lambda (&key signatures activeSignature
-                                          activeParameter)
+                                        activeParameter)
                        (when-buffer-window
                         (when (cl-plusp (length signatures))
                           (setq sig-showing t)
@@ -1063,7 +1063,7 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
                        (mapc #'delete-overlay eglot--highlights)
                        (setq eglot--highlights
                              (when-buffer-window
-                              (jrpc-mapply
+                              (mapcar
                                (jrpc-lambda (&key range _kind)
                                  (eglot--with-lsp-range (beg end) range
                                    (let ((ov (make-overlay beg end)))
@@ -1078,7 +1078,7 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
   "EGLOT's `imenu-create-index-function' overriding OLDFUN."
   (if (eglot--server-capable :documentSymbolProvider)
       (let ((entries
-             (jrpc-mapply
+             (mapcar
               (jrpc-lambda (&key name kind location _containerName)
                 (cons (propertize name :kind (cdr (assoc kind 
eglot--kind-names)))
                       (eglot--lsp-position-to-point
@@ -1098,14 +1098,13 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
   (unless (or (not version) (equal version eglot--versioned-identifier))
     (eglot--error "Edits on `%s' require version %d, you have %d"
                   (current-buffer) version eglot--versioned-identifier))
-  (jrpc-mapply
-   (jrpc-lambda (&key range newText)
-     (save-restriction
-       (widen)
-       (save-excursion
-         (eglot--with-lsp-range (beg end) range
-           (goto-char beg) (delete-region beg end) (insert newText)))))
-   edits)
+  (mapc (jrpc-lambda (&key range newText)
+          (save-restriction
+            (widen)
+            (save-excursion
+              (eglot--with-lsp-range (beg end) range
+                (goto-char beg) (delete-region beg end) (insert newText)))))
+        edits)
   (eglot--message "%s: Performed %s edits" (current-buffer) (length edits)))
 
 (defun eglot--apply-workspace-edit (wedit &optional confirm)
diff --git a/jrpc.el b/jrpc.el
index 3467b89..44719d9 100644
--- a/jrpc.el
+++ b/jrpc.el
@@ -332,7 +332,7 @@ is a symbol saying if this is a client or server 
originated."
 
 (defun jrpc--process-receive (proc message)
   "Process MESSAGE from PROC."
-  (cl-destructuring-bind (&key method id error params &allow-other-keys) 
message
+  (cl-destructuring-bind (&key method id error params result _jsonrpc) message
     (let* ((continuations (and id
                                (not method)
                                (gethash id (jrpc--request-continuations 
proc)))))
@@ -340,9 +340,7 @@ is a symbol saying if this is a client or server 
originated."
       (when error (setf (jrpc-status proc) `(,error t)))
       (cond (method
              (unwind-protect
-                 (if (listp params)
-                     (apply (jrpc--dispatcher proc) proc method id params)
-                   (funcall (jrpc--dispatcher proc) proc method id params))
+                 (funcall (jrpc--dispatcher proc) proc method id params)
                (unless (or (not id)
                            (member id (jrpc--server-request-ids proc)))
                  (jrpc-reply
@@ -354,11 +352,8 @@ is a symbol saying if this is a client or server 
originated."
              (cancel-timer (cl-third continuations))
              (remhash id (jrpc--request-continuations proc))
              (if error
-                 (apply (cl-second continuations) error)
-               (let ((res (plist-get message :result)))
-                 (if (listp res)
-                     (apply (cl-first continuations) res)
-                   (funcall (cl-first continuations) res)))))
+                 (funcall (cl-second continuations) error)
+               (funcall (cl-first continuations) result)))
             (id
              (jrpc-warn "Ooops no continuation for id %s" id)))
       (jrpc--call-deferred proc)
@@ -402,7 +397,8 @@ request request and a process object.")
 
 (cl-defmacro jrpc-lambda (cl-lambda-list &body body)
   (declare (indent 1) (debug (sexp &rest form)))
-  `(cl-function (lambda ,cl-lambda-list ,@body)))
+  (let ((e (gensym "jrpc-lambda-elem")))
+    `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
 
 (cl-defun jrpc-async-request (proc
                               method
@@ -480,16 +476,10 @@ DEFERRED is passed to `jrpc-async-request', which see."
           (catch tag
             (jrpc-async-request
              proc method params
-             :success-fn (lambda (&rest args)
-                           (throw tag
-                                  `(done ,(if (vectorp (car args))
-                                              (car args) args))))
+             :success-fn (lambda (result) (throw tag `(done ,result)))
              :error-fn (jrpc-lambda (&key code message &allow-other-keys)
-                         (throw tag
-                                `(error ,(format "Oops: %s: %s" code 
message))))
-             :timeout-fn (lambda ()
-                           (throw tag
-                                  '(error "Timed out")))
+                         (throw tag `(error ,(format "%s: %s" code message))))
+             :timeout-fn (lambda () (throw tag '(error "Timed out")))
              :deferred deferred)
             (while t (accept-process-output nil 30)))))
     (when (eq 'error (car retval)) (jrpc-error (cadr retval)))
@@ -509,9 +499,5 @@ DEFERRED is passed to `jrpc-async-request', which see."
                     ,@(when result `(:result ,result))
                     ,@(when error `(:error ,error)))))
 
-(defun jrpc-mapply (fun seq)
-  "Apply FUN to every element of SEQ."
-  (mapcar (lambda (e) (apply fun e)) seq))
-
 (provide 'jrpc)
 ;;; jrpc.el ends here