From 578ea8fda533d09776124510c6b962736337e139 Mon Sep 17 00:00:00 2001
From: Jay Xu <jay.xu.krfantasy@gmail.com>
Date: Fri, 5 Nov 2021 17:20:14 +0800
Subject: add debugger support

---
 geiser-chez.el       | 26 ++++++++++++++++++++++----
 src/geiser/geiser.ss | 11 +++++++----
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/geiser-chez.el b/geiser-chez.el
index 307356e..a3af75c 100644
--- a/geiser-chez.el
+++ b/geiser-chez.el
@@ -25,6 +25,7 @@
 (require 'geiser-edit)
 (require 'geiser-log)
 (require 'geiser-impl)
+(require 'geiser-repl)
 
 (require 'compile)
 (require 'info-look)
@@ -59,6 +60,11 @@
   :type '(repeat string)
   :group 'geiser-chez)
 
+(geiser-custom--defcustom geiser-chez-debug-on-exception-p nil
+  "Whether to automatically enter the debugger when catching an exception"
+  :type 'boolean
+  :group 'geiser-chez)
+
 
 ;;; REPL support:
 
@@ -83,6 +89,8 @@ This function uses `geiser-chez-init-file' if it exists."
 
 (defconst geiser-chez--prompt-regexp "> ")
 
+(defconst geiser-chez--debugger-prompt-regexp "debug> $\\|break> $\\|.+: $")
+
 
 ;;; Evaluation support:
 
@@ -148,13 +156,23 @@ This function uses `geiser-chez-init-file' if it exists."
 
 ;;; Error display:
 
+(defun geiser-chez--enter-debugger ()
+  "Tell Geiser to interact with the debugger."
+  (when geiser-chez-debug-on-exception-p
+    (let ((bt-cmd "\n(debug)\n")
+          (repl-buffer (geiser-repl--repl/impl 'chez)))
+      (compilation-forget-errors)
+      (goto-char (point-max))
+      (geiser-repl--prepare-send)
+      (comint-send-string repl-buffer bt-cmd)
+      (ignore-errors (next-error)))))
+
 (defun geiser-chez--display-error (_module key msg)
   "Display an error found during evaluation with the given KEY and message MSG."
   (when (stringp msg)
     (save-excursion (insert msg))
     (geiser-edit--buttonize-files))
-  (and (or (eq key 'chez-error-message)
-           (not key))
+  (and (not key)
        (not (zerop (length msg)))
        msg))
 
@@ -234,8 +252,8 @@ This function uses `geiser-chez-init-file' if it exists."
   (minimum-version geiser-chez-minimum-version)
   (repl-startup geiser-chez--startup)
   (prompt-regexp geiser-chez--prompt-regexp)
-  (debugger-prompt-regexp nil) ;; geiser-chez--debugger-prompt-regexp
-  ;; (enter-debugger geiser-chez--enter-debugger)
+  (debugger-prompt-regexp geiser-chez--debugger-prompt-regexp)
+  (enter-debugger geiser-chez--enter-debugger)
   (marshall-procedure geiser-chez--geiser-procedure)
   (find-module geiser-chez--get-module)
   ;; (enter-command geiser-chez--enter-command)
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 478b9af..afa58c3 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -54,11 +54,14 @@
         (lambda (k)
           (with-exception-handler
               (lambda (e)
+                (debug-condition e)     ; save the condition for the debugger
                 (k `((result "")
-                     (output . ,(with-output-to-string
-                                  (lambda ()
-                                    (display-condition e))))
-                     (error (key . chez-error-message)))))
+                     (output . ,(format "~a~%~a"
+                                        (get-output-string output-string)
+                                        (with-output-to-string
+                                          (lambda ()
+                                            (display-condition e)))))
+                     (error (key . geiser-debugger)))))
             (lambda ()
               (call-with-values
                   ;; evaluate form, allow for multiple return values,
-- 
cgit v1.2.3