Browse Source

lisp/ob-scheme.el: Fix scheme code blocks execution error in batch mode

* 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 non interactive
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.
KDr2 3 years ago
parent
commit
21d6d7c3a0
1 changed files with 20 additions and 3 deletions
  1. 20 3
      lisp/ob-scheme.el

+ 20 - 3
lisp/ob-scheme.el

@@ -118,6 +118,22 @@ 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))
+         (unwind-protect
+             (progn
+               (defun message (&rest args)
+                 (setq current-message (apply original-message args)))
+               ,@body
+               current-message)
+           (fset 'message original-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 +158,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)