From f20949e18314977bfa3c2ec1a59fb1e7b3269cbd Mon Sep 17 00:00:00 2001 From: KDr2 Date: Sat, 12 Apr 2014 15:59:37 +0800 Subject: [PATCH] lisp/ob-scheme.el: Fix scheme code blocks execution error in batch mode * lisp/ob-scheme.el (org-babel-scheme-capture-current-message, org-babel-scheme-execute-with-geiser): Capture scheme code results via current-message both in interactive mode and noninteractive mode. `org-babel-scheme-execute-with-geiser' uses `current-message' to get the results of scheme code blocks, but `current-message' always returns nil in batch mode, and this patch fixes this. Modified from a patch proposal by KDr2(killy.draw@gmail.com) --- lisp/ob-scheme.el | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index b7117e9..cf21311 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -118,6 +118,20 @@ org-babel-scheme-execute-with-geiser will use a temporary session." (name)))) result)) +(defmacro org-babel-scheme-capture-current-message (&rest body) + "Capture current message in both interactive and noninteractive mode" + `(if noninteractive + (let ((original-message (symbol-function 'message)) + (current-message nil)) + (defun message (&rest args) + (setq current-message (apply original-message args))) + (unwind-protect ,@body) + (fset 'message original-message) + current-message) + (progn + ,@body + (current-message)))) + (defun org-babel-scheme-execute-with-geiser (code output impl repl) "Execute code in specified REPL. If the REPL doesn't exist, create it using the given scheme implementation. @@ -142,10 +156,11 @@ is true; otherwise returns the last value." (current-buffer))))) (setq geiser-repl--repl repl-buffer) (setq geiser-impl--implementation nil) - (geiser-eval-region (point-min) (point-max)) + (setq result (org-babel-scheme-capture-current-message + (geiser-eval-region (point-min) (point-max)))) (setq result - (if (equal (substring (current-message) 0 3) "=> ") - (replace-regexp-in-string "^=> " "" (current-message)) + (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) -- 1.9.2