From c87786bc4b4d40cdda99a7fb006382c8a852928a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20L=2E=20Dom=C3=A9nech?= <address@hidden>
Date: Mon, 17 Jul 2017 08:42:32 +0200
Subject: [PATCH] Enhance the babel block for scheme.

Allows scheme code blocks to return a table and add a :prologue param
to the scheme blocks. All :prologue params are prepended to the
body of code.

* lisp/ob-scheme.el (org-babel-scheme-null-to): New custom option that
  allows to use a empty list to format the table output, initially
  assigned to 'hlines.
  (org-babel-scheme-table-or-string): New helper function to convert
  the return value from the block as a table or a string.
  (org-babel-execute-src-block): Changed to allow the return of a
  table for the output.
  (org-babel-expand-body:scheme) Add :prologue param support.
---
 lisp/ob-scheme.el | 53 ++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 40 insertions(+), 13 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index cd8c386..599ece7 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -51,14 +51,24 @@
                   (start end &optional and-go raw nomsg))
 (declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
 
+(defcustom org-babel-scheme-null-to 'hline
+  "Replace `null' in scheme tables with this before returning."
+  :group 'org-babel
+  :version "24.4"
+  :package-version '(Org . "8.0")
+  :type 'symbol)
+
 (defvar org-babel-default-header-args:scheme '()
   "Default header arguments for scheme code blocks.")
 
 (defun org-babel-expand-body:scheme (body params)
   "Expand BODY according to PARAMS, return the expanded body."
-  (let ((vars (org-babel--get-vars params)))
+  (let ((vars (org-babel--get-vars params))
+	(prepends (cl-remove-if-not (lambda (x) (eq (car x) :prologue)) params)))
     (if (> (length vars) 0)
-        (concat "(let ("
+        (concat (mapconcat (lambda (p) (format "%s" (cdr p)))
+			   prepends "\n     ")
+	        "(let ("
                 (mapconcat
                  (lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
                  vars "\n      ")
@@ -176,6 +186,18 @@ is true; otherwise returns the last value."
 		       result))))
     result))
 
+(defun org-babel-scheme-table-or-string (results)
+  "Convert RESULTS into an appropriate elisp value.
+If the results look like a list or tuple, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+  (let ((res (org-babel-script-escape results)))
+    (if (listp res)
+        (mapcar (lambda (el) (if (or (eq el '()) (eq el 'null))
+				 org-babel-scheme-null-to
+			       el))
+                res)
+      res)))
+
 (defun org-babel-execute:scheme (body params)
   "Execute a block of Scheme code with org-babel.
 This function is called by `org-babel-execute-src-block'"
@@ -184,7 +206,6 @@ This function is called by `org-babel-execute-src-block'"
 			      "^ ?\\*\\([^*]+\\)\\*" "\\1"
 			      (buffer-name source-buffer))))
     (save-excursion
-      (org-babel-reassemble-table
        (let* ((result-type (cdr (assq :result-type params)))
 	      (impl (or (when (cdr (assq :scheme params))
 			  (intern (cdr (assq :scheme params))))
@@ -192,16 +213,22 @@ This function is called by `org-babel-execute-src-block'"
 			(car geiser-active-implementations)))
 	      (session (org-babel-scheme-make-session-name
 			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 (assq :colname-names params))
-			    (cdr (assq :colnames params)))
-       (org-babel-pick-name (cdr (assq :rowname-names params))
-			    (cdr (assq :rownames params)))))))
+	      (full-body (org-babel-expand-body:scheme body params))
+	      (result
+	       (org-babel-scheme-execute-with-geiser
+		full-body			 ; code
+		(string= result-type "output")   ; output?
+		impl				 ; implementation
+		(and (not (string= session "none")) session))) ; session
+	      )
+	 (let ((table
+		(org-babel-reassemble-table
+		 result
+		 (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))))))
+	   (org-babel-scheme-table-or-string table))))))
 
 (provide 'ob-scheme)
 
-- 
2.7.4