nrepl-client.el (nrepl-send-sync-request): New optional argument

If provided, abort the loop immediately and return nil. This avoids
hanging the interface on background requests.

2 files changed, 33 insertions, 27 deletions

diff --git a/cider-client.el b/cider-client.el
index dec474b8..af92da93 100644
--- a/cider-client.el
+++ b/cider-client.el
@@ -179,13 +179,13 @@ loaded. If CALLBACK is nil, use `cider-load-file-handler'."
 
 (defun cider-sync-request:complete (str context)
   "Return a list of completions for STR using nREPL's \"complete\" op."
-  (-> (list "op" "complete"
-            "session" (nrepl-current-session)
-            "ns" (cider-current-ns)
-            "symbol" str
-            "context" context)
-      (nrepl-send-sync-request)
-      (nrepl-dict-get "completions")))
+  (-when-let (dict (-> (list "op" "complete"
+                             "session" (nrepl-current-session)
+                             "ns" (cider-current-ns)
+                             "symbol" str
+                             "context" context)
+                       (nrepl-send-sync-request 'abort-on-input)))
+    (nrepl-dict-get dict "completions")))
 
 (defun cider-sync-request:info (symbol &optional class member)
   "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER."
@@ -202,13 +202,13 @@ loaded. If CALLBACK is nil, use `cider-load-file-handler'."
 
 (defun cider-sync-request:eldoc (symbol &optional class member)
   "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER."
-  (let ((eldoc (-> `("op" "eldoc"
-                     "session" ,(nrepl-current-session)
-                     "ns" ,(cider-current-ns)
-                     ,@(when symbol (list "symbol" symbol))
-                     ,@(when class (list "class" class))
-                     ,@(when member (list "member" member)))
-                   (nrepl-send-sync-request))))
+  (-when-let (eldoc (-> `("op" "eldoc"
+                          "session" ,(nrepl-current-session)
+                          "ns" ,(cider-current-ns)
+                          ,@(when symbol (list "symbol" symbol))
+                          ,@(when class (list "class" class))
+                          ,@(when member (list "member" member)))
+                        (nrepl-send-sync-request 'abort-on-input)))
     (if (member "no-eldoc" (nrepl-dict-get eldoc "status"))
         nil
       eldoc)))
diff --git a/nrepl-client.el b/nrepl-client.el
index bdcd18a1..588dc579 100644
--- a/nrepl-client.el
+++ b/nrepl-client.el
@@ -922,15 +922,19 @@ REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
       (puthash id callback nrepl-pending-requests)
       (process-send-string nil message))))
 
-(defun nrepl-send-sync-request (request)
+(defun nrepl-send-sync-request (request &optional abort-on-input)
   "Send REQUEST to the nREPL server synchronously.
 Hold till final \"done\" message has arrived and join all response messages
-of the same \"op\" that came along."
+of the same \"op\" that came along.
+If ABORT-ON-INPUT is non-nil, the function will return nil at the first
+sign of user input, so as not to hang the interface."
   (let* ((time0 (current-time))
          (response (cons 'dict nil))
          status)
     (nrepl-send-request request (lambda (resp) (nrepl--merge response resp)))
-    (while (not (member "done" status))
+    (while (and (not (member "done" status))
+                (not (and abort-on-input
+                          (input-pending-p))))
       (setq status (nrepl-dict-get response "status"))
       ;; If we get a need-input message then the repl probably isn't going
       ;; anywhere, and we'll just timeout. So we forward it to the user.
@@ -947,16 +951,18 @@ of the same \"op\" that came along."
       ;; Clean up the response, otherwise we might repeatedly ask for input.
       (nrepl-dict-put response "status" nil)
       (accept-process-output nil 0.01))
-    (-when-let* ((ex (nrepl-dict-get response "ex"))
-                 (err (nrepl-dict-get response "err")))
-      (cider-repl-emit-interactive-err-output err)
-      (message err))
-    (-when-let (id (nrepl-dict-get response "id"))
-      ;; FIXME: This should go away eventually when we get rid of
-      ;; pending-request hash table
-      (with-current-buffer (nrepl-current-connection-buffer)
-        (remhash id nrepl-pending-requests)))
-    response))
+    ;; If we couldn't finish, return nil.
+    (when (member "done" status)
+      (-when-let* ((ex (nrepl-dict-get response "ex"))
+                   (err (nrepl-dict-get response "err")))
+        (cider-repl-emit-interactive-err-output err)
+        (message err))
+      (-when-let (id (nrepl-dict-get response "id"))
+        ;; FIXME: This should go away eventually when we get rid of
+        ;; pending-request hash table
+        (with-current-buffer (nrepl-current-connection-buffer)
+          (remhash id nrepl-pending-requests)))
+      response)))
 
 (defun nrepl-request:stdin (input callback)
   "Send a :stdin request with INPUT.