>From a02b60b88bcfd1896c05cd858ae80bb1ef183730 Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Sun, 20 Aug 2017 17:25:58 +0100
Subject: [PATCH] Improve Scheme code evaluation

* lisp/ob-scheme.el (org-babel-scheme-execute-with-geiser): Use
  Geiser's explicit 'retort' object, instead of catching and parsing
  an expected Emacs message (which for me is in any case overwritten
  by a following "Mark set" message); this also means we don't need
  the with-output-to-string approach for getting 'output' results.
  Also 'let' Geiser variables so as to avoid popping up the REPL
  and *Geiser dbg* buffers.
---
 lisp/ob-scheme.el | 56 +++++++++++++++++++++++++++----------------------------
 1 file changed, 28 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index b8867d5f6..bf1da01b0 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -150,35 +150,35 @@ is true; otherwise returns the last value."
     (with-temp-buffer
       (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
       (newline)
-      (insert (if output
-		  (format "(with-output-to-string (lambda () %s))" code)
-		code))
+      (insert code)
       (geiser-mode)
-      (let ((repl-buffer (save-current-buffer
-			   (org-babel-scheme-get-repl impl repl))))
-	(when (not (eq impl (org-babel-scheme-get-buffer-impl
-			     (current-buffer))))
-	  (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
-		   (org-babel-scheme-get-buffer-impl (current-buffer))
-		   (symbolp (org-babel-scheme-get-buffer-impl
-			     (current-buffer)))))
-	(setq geiser-repl--repl repl-buffer)
-	(setq geiser-impl--implementation nil)
-	(setq result (org-babel-scheme-capture-current-message
-		      (geiser-eval-region (point-min) (point-max))))
-	(setq result
-	      (if (and (stringp result) (equal (substring result 0 3) "=> "))
-		  (replace-regexp-in-string "^=> " "" result)
-		"\"An error occurred.\""))
-	(when (not repl)
-	  (save-current-buffer (set-buffer repl-buffer)
-			       (geiser-repl-exit))
-	  (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
-	  (kill-buffer repl-buffer))
-	(setq result (if (or (string= result "#<void>")
-			     (string= result "#<unspecified>"))
-			 nil
-		       result))))
+      (let ((geiser-repl-window-allow-split nil)
+	    (geiser-repl-use-other-window nil))
+	(let ((repl-buffer (save-current-buffer
+			     (org-babel-scheme-get-repl impl repl))))
+	  (when (not (eq impl (org-babel-scheme-get-buffer-impl
+			       (current-buffer))))
+	    (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+		     (org-babel-scheme-get-buffer-impl (current-buffer))
+		     (symbolp (org-babel-scheme-get-buffer-impl
+			       (current-buffer)))))
+	  (setq geiser-repl--repl repl-buffer)
+	  (setq geiser-impl--implementation nil)
+	  (let ((geiser-debug-jump-to-debug-p nil)
+		(geiser-debug-show-debug-p nil))
+	    (let ((ret (geiser-eval-region (point-min) (point-max))))
+	      (setq result (if output
+			       (geiser-eval--retort-output ret)
+			     (geiser-eval--retort-result-str ret "")))))
+	  (when (not repl)
+	    (save-current-buffer (set-buffer repl-buffer)
+				 (geiser-repl-exit))
+	    (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+	    (kill-buffer repl-buffer))
+	  (setq result (if (or (string= result "#<void>")
+			       (string= result "#<unspecified>"))
+			   nil
+			 result)))))
     result))
 
 (defun org-babel-scheme--table-or-string (results)
-- 
2.13.2