emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "\"José L. Doménech\"" <domenechjosel@gmail.com>
To: "\"José Luis Doménech Martínez\"" <domenechjosel@gmail.com>
Cc: Org Mode <emacs-orgmode@gnu.org>
Subject: [PATCH] An amended to the enhance Org babel for scheme blocks
Date: Mon, 17 Jul 2017 19:55:32 +0200	[thread overview]
Message-ID: <87eftfq76z.wl-domenechjosel@gmail.com> (raw)
In-Reply-To: <87o9skwbrh.wl-domenechjosel@gmail.com>

[-- Attachment #1: Type: text/plain, Size: 916 bytes --]

Hello again, I have added a :prologue param to the scheme blocks of babel.
This multiple option prepends all the values in the generated code of the
block.

This patch also includes the previous one that enabled returning a table
when evaluating a scheme block.

A changelog:

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.

The patch:


[-- Attachment #2: 0001-Enhance-the-babel-block-for-scheme.patch --]
[-- Type: text/plain, Size: 4588 bytes --]

From c87786bc4b4d40cdda99a7fb006382c8a852928a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20L=2E=20Dom=C3=A9nech?= <domenechjosel@gmail.com>
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


[-- Attachment #3: Type: text/plain, Size: 4375 bytes --]


I hope it will be useful for someone.

José L. Doménech

On Sun, 16 Jul 2017 19:08:02 +0200,
José L. Doménech wrote:
> 
> [1  <text/plain; US-ASCII (7bit)>]
> 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.
> 
> [2 ob-scheme.el.diff <text/plain; US-ASCII (base64)>]
> 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)
>  
> [3  <text/plain; ISO-8859-1 (quoted-printable)>]
> 
> 
> Best regards:
> 
> José L. Doménech

  reply	other threads:[~2017-07-17 17:57 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-07-16 17:08 Enhance Org babel scheme "José L. Doménech"
2017-07-17 17:55 ` "José L. Doménech" [this message]
2017-07-23  9:32   ` [PATCH] An amended to the enhance Org babel for scheme blocks Nicolas Goaziou
2017-07-24  7:27     ` "José L. Doménech"
2017-07-24 10:06       ` Nicolas Goaziou
2017-07-24 10:44         ` "José L. Doménech"

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87eftfq76z.wl-domenechjosel@gmail.com \
    --to=domenechjosel@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).