From f6c09395b569f273ca27bc951ec5b882f2c3da86 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 28 Jan 2010 14:54:42 +0100
Subject: Guile: support for the REPL debugger

On errors, we switch to the REPL, where the debugger is active.
---
 elisp/geiser-guile.el              | 32 ++++++++++----------------------
 scheme/guile/geiser/evaluation.scm | 19 ++++---------------
 2 files changed, 14 insertions(+), 37 deletions(-)

diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 3008878..89b80d7 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -63,33 +63,12 @@ This function uses `geiser-guile-init-file' if it exists."
     ,@(and init-file (file-readable-p init-file) (list "-l" init-file)))))
 
 (defconst geiser-guile--prompt-regexp "^[^() \n]+@([^)]*?)> ")
-
-
-;;; Catching the debugger
-(make-variable-buffer-local
- (defvar geiser-guile--is-debugging nil))
-
-(defun geiser-guile--is-debugging ()
-  (with-current-buffer (geiser-repl--get-repl geiser-impl--implementation)
-    geiser-guile--is-debugging))
-
-(defvar geiser-guile--debugger-prompt-regexp "[0-9]+ debug> *$")
-(defun geiser-guile--watch-debugger (str)
-  (setq geiser-guile--is-debugging
-        (string-match-p geiser-guile--debugger-prompt-regexp str)))
-
-(defun geiser-guile--startup ()
-  (add-hook 'comint-output-filter-functions
-            'geiser-guile--watch-debugger
-            nil
-            t))
+(defconst geiser-guile--debugger-prompt-regexp "[0-9]+ debug> *")
 
 
 ;;; Evaluation support:
 
 (defun geiser-guile--geiser-procedure (proc)
-  (when (geiser-guile--is-debugging)
-    (error "(Guile REPL is in debug mode)"))
   (let ((proc (intern (format "ge:%s" (if (eq proc 'eval) 'compile proc)))))
     `(@ (geiser emacs) ,proc)))
 
@@ -163,6 +142,14 @@ This function uses `geiser-guile-init-file' if it exists."
     (goto-char (point-min))
     (re-search-forward geiser-guile--module-re nil t)))
 
+
+;;; Compilation shell regexps
+(defun geiser-guile--startup ()
+  (set (make-local-variable 'compilation-error-regexp-alist)
+       '(("^In \\([^:]+\\):" 1)
+         ("^  \\([0-9]+\\):  " nil 1)))
+  (compilation-setup t))
+
 
 ;;; Implementation definition:
 
@@ -171,6 +158,7 @@ This function uses `geiser-guile-init-file' if it exists."
   (arglist geiser-guile--parameters)
   (startup geiser-guile--startup)
   (prompt-regexp geiser-guile--prompt-regexp)
+  (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp)
   (marshall-procedure geiser-guile--geiser-procedure)
   (find-module geiser-guile--get-module)
   (find-symbol-begin geiser-guile--symbol-begin)
diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm
index 3a834bb..cd8a6f7 100644
--- a/scheme/guile/geiser/evaluation.scm
+++ b/scheme/guile/geiser/evaluation.scm
@@ -41,26 +41,15 @@
              m))))
 
 (define (ge:compile form module-name)
-  (let* ((module (or (find-module module-name)
-                     (current-module)))
+  (let* ((module (or (find-module module-name) (current-module)))
          (result #f)
-         (captured-stack #f)
-         (err #f)
          (ev (lambda ()
                (set! result (call-with-values
                                 (lambda () (compile form #:env module))
                               (lambda vs (map object->string vs)))))))
-    (let ((output
-           (with-output-to-string
-             (lambda ()
-               (catch #t
-                 (lambda () (start-stack 'geiser-eval (ev)))
-                 (lambda args
-                   (set! err (apply handle-error captured-stack args)))
-                 (lambda args
-                   (set! captured-stack (make-stack #t 11 11))))))))
-      (write `(,(or err (cons 'result result))
-               (output . ,output)))
+    (let (#;(output (with-output-to-string ev)))
+      (ev)
+      (write `(,(cons 'result result) (output . "")))
       (newline))))
 
 (define ge:eval ge:compile)
-- 
cgit v1.2.3