Hello, I have modified 'ob-scheme.el' to be able to return org tables.

This is a quick patch. I hope you find it useful buut I could modify,
document or write test for it if necesary.

I have already assigned the copyright for Emacs to the FSF.


Enhance the scheme babel block output.

Allow scheme code blocks to return a table.

* 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.

1 file changed, 35 insertions(+), 11 deletions(-)
lisp/ob-scheme.el | 46 +++++++++++++++++++++++++++++++++++-----------

modified   lisp/ob-scheme.el
@@ -51,6 +51,13 @@
                   (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.")
 
@@ -176,6 +183,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 +203,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 +210,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)
 

Best regards:

José L. Doménech

Reply via email to