From c21b375451a6b47bcb922514a962c9e2dabcf3f0 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 7 Sep 2010 00:22:37 +0200
Subject: Support for evaluation warnings

---
 elisp/geiser-debug.el  | 42 +++++++++++++++++++++++-------------------
 elisp/geiser-edit.el   | 14 ++++++++++++++
 elisp/geiser-syntax.el |  4 ++++
 3 files changed, 41 insertions(+), 19 deletions(-)

diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 909dffb..7f70d19 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -65,29 +65,33 @@ and the accompanying error message) and should display
 error was successfully displayed, the call should evaluate to a
 non-null value.")
 
+(geiser-impl--define-caller geiser-debug--enter-debugger
+    enter-debugger ()
+  "This method is called upon entering the debugger, in the REPL
+buffer.")
+
 (defun geiser-debug--display-retort (what ret &optional res)
   (let* ((err (geiser-eval--retort-error ret))
          (key (geiser-eval--error-key err))
          (output (geiser-eval--retort-output ret))
          (impl geiser-impl--implementation)
-         (module (geiser-eval--get-module)))
-    (if (eq key 'geiser-debugger)
-        (progn
-          (switch-to-geiser nil nil (current-buffer))
-          (geiser-debug--display-error impl module key output))
-      (geiser-debug--with-buffer
-        (erase-buffer)
-        (insert what)
-        (newline 2)
-        (when (and res (not err))
-          (insert res)
-          (newline 2))
-        (unless (geiser-debug--display-error impl module key output)
-          (when err (insert (geiser-eval--error-str err) "\n\n"))
-          (when output (insert output "\n\n")))
-        (goto-char (point-min)))
-      (when (or err (and output (> (length output) 0)))
-        (geiser-debug--pop-to-buffer)))))
+         (module (geiser-eval--get-module))
+         (jump nil)
+         (buffer (current-buffer))
+         (debug (eq key 'geiser-debugger)))
+    (when debug
+      (switch-to-geiser nil nil buffer)
+      (geiser-debug--enter-debugger impl))
+    (geiser-debug--with-buffer
+      (erase-buffer)
+      (insert what)
+      (newline 2)
+      (when (and res (not err))
+        (insert res)
+        (newline 2))
+      (setq jump (geiser-debug--display-error impl module key output))
+      (goto-char (point-min)))
+    (when jump (geiser-debug--pop-to-buffer))))
 
 (defsubst geiser-debug--wrap-region (str)
   (format "(begin %s)" str))
@@ -107,7 +111,7 @@ non-null value.")
     (geiser-autodoc--clean-cache)
     (when and-go (funcall and-go))
     (when (not err) (message "%s" res))
-    (geiser-debug--display-retort str ret res)))
+    (geiser-debug--display-retort (geiser-syntax--scheme-str str) ret res)))
 
 (defun geiser-debug--expand-region (start end all wrap)
   (let* ((str (buffer-substring-no-properties start end))
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index e63a91b..55106d3 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -142,6 +142,20 @@ or following links in error buffers.")
                (geiser-edit--make-location 'error file line col)
                'help-echo "Go to error location"))
 
+(defconst geiser-edit--default-file-rx
+  "^\\([^<>:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+
+(defun geiser-edit--buttonize-files (&optional rx)
+  (let ((rx (or rx geiser-edit--default-file-rx)))
+    (save-excursion
+      (while (re-search-forward rx nil t)
+        (geiser-edit--make-link (match-beginning 1)
+                                (match-end 1)
+                                (match-string 1)
+                                (match-string 2)
+                                (match-string 3)
+                                'window)))))
+
 
 ;;; Commands:
 
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 1247cf6..551ee6a 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -47,6 +47,7 @@
  (let+ 1)
  (let: 1)
  (letrec: 1)
+ (letrec* 1)
  (letrec-values 1)
  (letrec-values: 1)
  (let-values 1)
@@ -73,6 +74,9 @@
  (unless 1)
  (when 1)
  (while 1)
+ (with-fluid* 1)
+ (with-fluids 1)
+ (with-fluids* 1)
  (with-handlers 1)
  (with-handlers: 1)
  (with-method 1)
-- 
cgit v1.2.3