'debug commands so that each impl can take care of them

3 files changed, 41 insertions, 2 deletions

diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index e3f2bb5..e1f37b7 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -23,6 +23,7 @@
 (require 'geiser-base)
 (require 'geiser-image)
 
+(require 'transient)
 (require 'ansi-color)
 
 
@@ -112,12 +113,40 @@ all ANSI sequences."
   (let ((m (funcall (if nextp 'next-button 'previous-button) (point))))
     (and m (funcall (if nextp '< '>) (point) (marker-position m)))))
 
+(defvar-local geiser-debug--debugger-active-p nil)
+(defvar-local geiser-debug--sender-buffer nil)
+
 (geiser-menu--defmenu debug geiser-debug-mode-map
   ("Next error" "n" forward-button :enable (geiser-debug--button-p t))
   ("Previous error" "p" backward-button :enable (geiser-debug--button-p t))
+  ("Debugger command" ","
+   geiser-debug--debugger-transient :enable geiser-debug--debugger-active-p)
   --
   ("Quit" nil View-quit))
 
+(defun geiser-debug--send-to-repl (thing)
+  (unless geiser-debug--sender-buffer (error "Debugger not active"))
+  (with-current-buffer geiser-debug--sender-buffer
+    (let* ((ret (geiser-eval--send/wait (list :debug thing)))
+           (res (geiser-eval--retort-result-str ret nil)))
+      (geiser-debug--display-retort "" ret res))))
+
+(defun geiser-debug-debugger-quit ()
+  "Quit the current debugging session level"
+  (interactive)
+  (geiser-debug--send-to-repl ",q"))
+
+(defun geiser-debug-debugger-backtrace ()
+  "Quit the current debugging session level"
+  (interactive)
+  (geiser-debug--send-to-repl ",bt"))
+
+(transient-define-prefix geiser-debug--debugger-transient ()
+  "Debugging meta-commands"
+  ["Debugger"
+   ("q" "Quit current debugger level" geiser-debug-debugger-quit)
+   ("bt" "Display backtrace" geiser-debug-debugger-quit)])
+
 
 ;;; Buffer for displaying evaluation results:
 
@@ -182,6 +211,8 @@ buffer.")
          (after (geiser-debug--display-after what)))
     (unless debug-entered
       (geiser-debug--with-buffer
+        (setq geiser-debug--debugger-active-p debug
+              geiser-debug--sender-buffer buffer)
         (erase-buffer)
         (when dir (setq default-directory dir))
         (unless after (insert what "\n\n"))
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 80a40fd..7b7ab64 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -69,6 +69,10 @@ module-exports, autodoc, callers, callees and generic-methods.")
 
 ;;; Code formatting:
 
+(defsubst geiser-eval--debug (cmd)
+  (geiser-eval--form 'debug
+                     (geiser-eval--scheme-str file)))
+
 (defsubst geiser-eval--load-file (file)
   (geiser-eval--form 'load-file
                      (geiser-eval--scheme-str file)))
@@ -103,7 +107,8 @@ module-exports, autodoc, callers, callees and generic-methods.")
         ((eq code :f) "#f")
         ((eq code :t) "#t")
         ((listp code)
-         (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code)))
+         (cond ((eq (car code) :debug) (geiser-eval--debug (cdr code)))
+               ((eq (car code) :eval) (geiser-eval--eval (cdr code)))
                ((eq (car code) :comp) (geiser-eval--comp (cdr code)))
                ((eq (car code) :load-file)
                 (geiser-eval--load-file (cadr code)))
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index 58fa810..3fd9f92 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -694,8 +694,11 @@ If SAVE-HISTORY is non-nil, save CMD in the REPL history."
     (setq geiser-repl--repls (remove cb geiser-repl--repls))
     (unless (eq cb geiser-repl--connection-buffer)
       (when (buffer-live-p geiser-repl--connection-buffer)
+        (kill-buffer geiser-repl--connection-buffer)
         (setq geiser-repl--connection-buffer nil)
-        (kill-buffer geiser-repl--connection-buffer)))
+        (when-let (a (geiser-repl--connection-address
+                      geiser-impl--implementation))
+          (delete-file a))))
     (dolist (buffer (buffer-list))
       (when (buffer-live-p buffer)
         (with-current-buffer buffer