From 8bc53c168e72d9ec2ce9353298c3df6d0ab59a4f Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Mon, 20 Dec 2021 22:46:09 +0000
Subject: Asynchronous, interruptable evaluations

---
 elisp/geiser-connection.el |  6 +++++
 elisp/geiser-debug.el      | 61 +++++++++++++++++++++++++---------------------
 elisp/geiser-eval.el       |  5 ++++
 elisp/geiser-mode.el       |  2 ++
 4 files changed, 46 insertions(+), 28 deletions(-)

(limited to 'elisp')

diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index 344fbe2..745aa14 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -254,6 +254,12 @@
 (defvar geiser-connection-timeout 30000
   "Time limit, in msecs, blocking on synchronous evaluation requests")
 
+(defun geiser-con--interrupt (con)
+  "Interrupt any request being currently in process."
+  (when-let (proc (and con (geiser-con--connection-process con)))
+    (when (process-live-p proc)
+      (interrupt-process proc))))
+
 (defun geiser-con--send-string/wait (con str cont &optional timeout sbuf)
   (save-current-buffer
     (let ((proc (and con (geiser-con--connection-process con))))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index af4c8db..f5b98a3 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -1,4 +1,4 @@
-;;; geiser-debug.el -- displaying debug information and evaluation results
+;;; geiser-debug.el -- displaying debug and eval info  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2020, 2021 Jose Antonio Ortega Ruiz
 
@@ -289,37 +289,42 @@ buffer.")
   (let* ((str (buffer-substring-no-properties start end))
          (wrapped (if wrap (geiser-debug--wrap-region str) str))
          (code `(,(if compile :comp :eval) (:scm ,wrapped)))
-         (ret (geiser-eval--send/wait code))
-         (res (geiser-eval--retort-result-str ret nil))
-         (err (geiser-eval--retort-error ret)))
-    (when and-go (funcall and-go))
-    (when (not err)
-      (save-excursion
-        (goto-char (/ (+ end start) 2))
-        (geiser-autodoc--clean-cache))
-      (unless nomsg
-        (save-match-data
-          (when (string-match "\\(?:[ \t\n\r]+\\)\\'" res)
-            (setq res (replace-match "" t t res))))
-        (message "%s" res)))
-    (geiser-debug--display-retort (geiser-syntax--scheme-str str) ret res)
-    ret))
+         (cont (lambda (ret)
+                 (let ((res (geiser-eval--retort-result-str ret nil))
+                       (err (geiser-eval--retort-error ret))
+                       (scstr (geiser-syntax--scheme-str str)))
+                   (when and-go (funcall and-go))
+                   (when (not err)
+                     (save-excursion
+                       (goto-char (/ (+ end start) 2))
+                       (geiser-autodoc--clean-cache))
+                     (unless nomsg
+                       (save-match-data
+                         (when (string-match "\\(?:[ \t\n\r]+\\)\\'" res)
+                           (setq res (replace-match "" t t res))))
+                       (message "%s" res)))
+                   (geiser-debug--display-retort scstr ret res)))))
+    (geiser-eval--send code cont (current-buffer))))
 
 (defun geiser-debug--expand-region (start end all wrap)
   (let* ((str (buffer-substring-no-properties start end))
          (wrapped (if wrap (geiser-debug--wrap-region str) str))
-         (code `(:eval (:ge macroexpand (quote (:scm ,wrapped))
-                            ,(if all :t :f))))
-         (ret (geiser-eval--send/wait code))
-         (err (geiser-eval--retort-error ret))
-         (result (geiser-eval--retort-result ret)))
-    (if err
-        (geiser-debug--display-retort str ret)
-      (geiser-debug--with-buffer
-        (erase-buffer)
-        (insert (format "%s" (if wrap (geiser-debug--unwrap result) result)))
-        (goto-char (point-min)))
-      (geiser-debug--pop-to-buffer))))
+         (code
+          `(:eval (:ge macroexpand (quote (:scm ,wrapped)) ,(if all :t :f))))
+         (cont (lambda (ret)
+                 (let ((err (geiser-eval--retort-error ret))
+                       (result (geiser-eval--retort-result ret)))
+                   (if err
+                       (geiser-debug--display-retort str ret)
+                     (geiser-debug--with-buffer
+                       (erase-buffer)
+                       (insert (format "%s"
+                                       (if wrap
+                                           (geiser-debug--unwrap result)
+                                         result)))
+                       (goto-char (point-min)))
+                     (geiser-debug--pop-to-buffer))))))
+    (geiser-eval--send code cont (current-buffer))))
 
 
 (provide 'geiser-debug)
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 1019e55..424d8e2 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -156,6 +156,11 @@ module-exports, autodoc, callers, callees and generic-methods.")
                                 buffer)
   geiser-eval--sync-retort)
 
+(defun geiser-eval-interrupt ()
+  "Interrupt on-going evaluation, if any."
+  (interactive)
+  (geiser-con--interrupt (geiser-eval--connection)))
+
 
 ;;; Retort parsing:
 
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 4af9095..1e5df0b 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -297,6 +297,8 @@ With prefix, try to enter the current buffer's module."
       ("Eval buffer" "\C-c\C-b" geiser-eval-buffer)
       ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go)
       ("Load scheme file..." "\C-c\C-l" geiser-load-file)
+      ("Abort evaluation" ("\C-c\C-i" "\C-c\C-e\C-i" "\C-c\C-ei")
+       geiser-eval-interrupt)
       (menu "Macroexpand"
             ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
              geiser-expand-last-sexp)
-- 
cgit v1.2.3