Update Org to v9.0.9

Please see etc/ORG-NEWS for details.

1 files changed, 31 insertions, 14 deletions

diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index ae77c7c3edf..cd8c3860e25 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -1,4 +1,4 @@
-;;; ob-scheme.el --- org-babel functions for Scheme
+;;; ob-scheme.el --- Babel Functions for Scheme      -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
 
@@ -56,7 +56,7 @@
 
 (defun org-babel-expand-body:scheme (body params)
   "Expand BODY according to PARAMS, return the expanded body."
-  (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+  (let ((vars (org-babel--get-vars params)))
     (if (> (length vars) 0)
         (concat "(let ("
                 (mapconcat
@@ -119,6 +119,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.
@@ -143,10 +159,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)
@@ -156,7 +173,7 @@ is true; otherwise returns the last value."
 	(setq result (if (or (string= result "#<void>")
 			     (string= result "#<unspecified>"))
 			 nil
-		       (read result)))))
+		       result))))
     result))
 
 (defun org-babel-execute:scheme (body params)
@@ -168,23 +185,23 @@ This function is called by `org-babel-execute-src-block'"
 			      (buffer-name source-buffer))))
     (save-excursion
       (org-babel-reassemble-table
-       (let* ((result-type (cdr (assoc :result-type params)))
-	      (impl (or (when (cdr (assoc :scheme params))
-			  (intern (cdr (assoc :scheme params))))
+       (let* ((result-type (cdr (assq :result-type params)))
+	      (impl (or (when (cdr (assq :scheme params))
+			  (intern (cdr (assq :scheme params))))
 			geiser-default-implementation
 			(car geiser-active-implementations)))
 	      (session (org-babel-scheme-make-session-name
-			source-buffer-name (cdr (assoc :session params)) impl))
+			source-buffer-name (cdr (assq :session params)) impl))
 	      (full-body (org-babel-expand-body:scheme body params)))
 	 (org-babel-scheme-execute-with-geiser
 	  full-body			 ; code
 	  (string= result-type "output") ; output?
 	  impl				 ; implementation
 	  (and (not (string= session "none")) session))) ; session
-       (org-babel-pick-name (cdr (assoc :colname-names params))
-			    (cdr (assoc :colnames params)))
-       (org-babel-pick-name (cdr (assoc :rowname-names params))
-			    (cdr (assoc :rownames params)))))))
+       (org-babel-pick-name (cdr (assq :colname-names params))
+			    (cdr (assq :colnames params)))
+       (org-babel-pick-name (cdr (assq :rowname-names params))
+			    (cdr (assq :rownames params)))))))
 
 (provide 'ob-scheme)