瀏覽代碼

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 11 年之前
父節點
當前提交
21d6d7c3a0
共有 1 個文件被更改,包括 20 次插入3 次删除
  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))))
 	       (name))))
     result))
     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)
 (defun org-babel-scheme-execute-with-geiser (code output impl repl)
   "Execute code in specified REPL. If the REPL doesn't exist, create it
   "Execute code in specified REPL. If the REPL doesn't exist, create it
 using the given scheme implementation.
 using the given scheme implementation.
@@ -142,10 +158,11 @@ is true; otherwise returns the last value."
 			     (current-buffer)))))
 			     (current-buffer)))))
 	(setq geiser-repl--repl repl-buffer)
 	(setq geiser-repl--repl repl-buffer)
 	(setq geiser-impl--implementation nil)
 	(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
 	(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.\""))
 		"\"An error occurred.\""))
 	(when (not repl)
 	(when (not repl)
 	  (save-current-buffer (set-buffer repl-buffer)
 	  (save-current-buffer (set-buffer repl-buffer)