Debugger: fixes and better determination of debugging status

3 files changed, 64 insertions, 56 deletions

diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index 1068330..344fbe2 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -157,9 +157,9 @@
     new))
 
 (defun geiser-con--has-entered-debugger (con answer)
-  (and (not (geiser-con--connection-is-debugging con))
-       (let ((p (car (last (split-string answer "\n" t)))))
-         (and p (geiser-con--connection-update-debugging con p)))))
+  (when-let ((p (car (last (split-string answer "\n" t)))))
+    (geiser-con--connection-update-debugging con p))
+  (geiser-con--connection-is-debugging con))
 
 (defun geiser-con--connection-eot-p (con txt)
   (and txt
@@ -199,17 +199,18 @@
 ;;; Requests handling:
 
 (defun geiser-con--req-form (req answer)
-  (let ((con (geiser-con--request-connection req)))
-    (if (geiser-con--has-entered-debugger con answer)
-        `((error (key . geiser-debugger))
-          (output . ,answer))
-      (condition-case err
-          (let ((start (string-match "((\\(?:result)?\\|error\\) " answer)))
-            (or (and start (car (read-from-string answer start)))
-                `((error (key . retort-syntax)) (output . ,answer))))
-        (error `((error (key . geiser-con-error))
-                 (output . ,(format "%s\n(%s)"
-                                    answer (error-message-string err)))))))))
+  (let* ((con (geiser-con--request-connection req))
+         (debugging (geiser-con--has-entered-debugger con answer)))
+    (condition-case err
+        (let ((start (string-match "((\\(?:result)?\\|error\\) " answer)))
+          (or (and start (car (read-from-string answer start)))
+              `((error (key . retort-syntax))
+                (output . ,answer)
+                (debug . ,debugging))))
+      (error `((error (key . geiser-con-error))
+               (debug . debugging)
+               (output . ,(format "%s\n(%s)"
+                                  answer (error-message-string err))))))))
 
 (defun geiser-con--process-completed-request (req answer)
   (let ((cont (geiser-con--request-continuation req))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index e1f37b7..f73b6cd 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -107,45 +107,57 @@ all ANSI sequences."
   (buffer-disable-undo)
   (set-syntax-table scheme-mode-syntax-table)
   (setq next-error-function 'geiser-edit--open-next)
+  (compilation-minor-mode 1)
   (setq buffer-read-only t))
 
-(defun geiser-debug--button-p (nextp)
-  (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)
+  ("Next error" "n" compilation-next-error)
+  ("Previous error" "p" compilation-previous-error)
+  ("Debugger command" "," geiser-debug--debugger-transient
+   :enable geiser-debug--debugger-active-p)
+  ("Source buffer" ("z" (kbd "C-c C-z")) geiser-debug-switch-to-buffer)
   --
   ("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))))
+  (unless (and geiser-debug--debugger-active-p geiser-debug--sender-buffer)
+    (error "Debugger not active"))
+  (save-window-excursion
+    (with-current-buffer geiser-debug--sender-buffer
+      (let* ((ret (geiser-eval--send/wait (cons :debug thing)))
+             (res (geiser-eval--retort-result-str ret nil)))
+        (geiser-debug--display-retort (format ",%s" thing) ret res)))))
+
+(defun geiser-debug-switch-to-buffer ()
+  "Return to the scheme buffer that pooped this debug window."
+  (interactive)
+  (when geiser-debug--sender-buffer
+    (geiser-repl--switch-to-buffer geiser-debug--sender-buffer)))
 
 (defun geiser-debug-debugger-quit ()
   "Quit the current debugging session level"
   (interactive)
-  (geiser-debug--send-to-repl ",q"))
+  (geiser-debug--send-to-repl 'quit))
 
 (defun geiser-debug-debugger-backtrace ()
   "Quit the current debugging session level"
   (interactive)
-  (geiser-debug--send-to-repl ",bt"))
+  (geiser-debug--send-to-repl 'bt))
 
 (transient-define-prefix geiser-debug--debugger-transient ()
   "Debugging meta-commands"
-  ["Debugger"
+  [:description (lambda () (format "%s debugger" (geiser-impl--impl-str)))
+   :if (lambda () geiser-debug--debugger-active-p)
    ("q" "Quit current debugger level" geiser-debug-debugger-quit)
-   ("bt" "Display backtrace" geiser-debug-debugger-quit)])
+   ("bt" "Display backtrace" geiser-debug-debugger-backtrace)])
+
+
+;;; Implementation-dependent functionality
+(geiser-impl--define-caller geiser-debug--clean-up-output clean-up-output (output)
+  "Clean up output from an evaluation for display.")
 
 
 ;;; Buffer for displaying evaluation results:
@@ -188,31 +200,28 @@ buffer.")
 
 (declare-function switch-to-geiser "geiser-repl")
 
-(defun geiser-debug--remove-prompt (impl str)
-  (replace-regexp-in-string (or (geiser-repl--debugger-prompt-regexp impl) "^$")
-                            ""
-                            str))
-
 (defun geiser-debug--display-retort (what ret &optional res auto-p)
   (let* ((err (geiser-eval--retort-error ret))
          (key (geiser-eval--error-key err))
-         (output (geiser-eval--retort-output ret))
-         (output (and (stringp output) (not (string= output "")) output))
+         (debug (alist-get 'debug ret))
          (impl geiser-impl--implementation)
+         (output (geiser-eval--retort-output ret))
+         (output (and (stringp output)
+                      (not (string= output ""))
+                      (or (geiser-debug--clean-up-output impl output) output)))
          (module (geiser-eval--get-module))
          (img nil)
          (dir default-directory)
          (buffer (current-buffer))
-         (debug (eq key 'geiser-debugger))
-         (output (if debug (geiser-debug--remove-prompt impl output) output))
-         (debug-entered (when debug
-                          (switch-to-geiser nil nil buffer)
-                          (geiser-debug--enter-debugger impl)))
+         (debug-entered (when debug (geiser-debug--enter-debugger impl)))
          (after (geiser-debug--display-after what)))
     (unless debug-entered
       (geiser-debug--with-buffer
+        (when (and (not debug) geiser-debug--debugger-active-p)
+          (message "Debugger exited"))
         (setq geiser-debug--debugger-active-p debug
-              geiser-debug--sender-buffer buffer)
+              geiser-debug--sender-buffer buffer
+              geiser-impl--implementation impl)
         (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 7b7ab64..f5cbccd 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -1,6 +1,6 @@
 ;;; geiser-eval.el -- sending scheme code for evaluation
 
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2021 Jose Antonio Ortega Ruiz
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the Modified BSD License. You should
@@ -35,9 +35,11 @@ an optional argument, for cases where we want to force its
 value.")
 
 (defun geiser-eval--get-module (&optional module)
-  (if geiser-eval--get-module-function
-      (funcall geiser-eval--get-module-function module)
-    (funcall geiser-eval--get-impl-module module)))
+  (cond (geiser-eval--get-module-function
+         (funcall geiser-eval--get-module-function module))
+        (geiser-eval--get-impl-module
+         (funcall geiser-eval--get-impl-module module))
+        (t module)))
 
 (defvar geiser-eval--geiser-procedure-function)
 (geiser-impl--register-local-method
@@ -70,16 +72,13 @@ module-exports, autodoc, callers, callees and generic-methods.")
 ;;; Code formatting:
 
 (defsubst geiser-eval--debug (cmd)
-  (geiser-eval--form 'debug
-                     (geiser-eval--scheme-str file)))
+  (geiser-eval--form 'debug (geiser-eval--scheme-str cmd)))
 
 (defsubst geiser-eval--load-file (file)
-  (geiser-eval--form 'load-file
-                     (geiser-eval--scheme-str file)))
+  (geiser-eval--form 'load-file (geiser-eval--scheme-str file)))
 
 (defsubst geiser-eval--comp-file (file)
-  (geiser-eval--form 'compile-file
-                     (geiser-eval--scheme-str file)))
+  (geiser-eval--form 'compile-file (geiser-eval--scheme-str file)))
 
 (defsubst geiser-eval--module (code)
   (geiser-eval--scheme-str
@@ -99,8 +98,7 @@ module-exports, autodoc, callers, callees and generic-methods.")
                      (geiser-eval--scheme-str (nth 0 code))))
 
 (defsubst geiser-eval--ge (proc args)
-  (apply 'geiser-eval--form (cons proc
-                                  (mapcar 'geiser-eval--scheme-str args))))
+  (apply 'geiser-eval--form (cons proc (mapcar 'geiser-eval--scheme-str args))))
 
 (defun geiser-eval--scheme-str (code)
   (cond ((null code) "'()")