Re: babel default header args as functions

[Matt Huszagh <huszaghmatt@gmail.com>]

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

Tom Gillespie <tgbugs@gmail.com> writes:

> [...] I have a number of use
> cases that I can imagine would benefit greatly from being able to
> define a :header-args: :header (lambda () "yay!") property as a
> closure (and actually I assumed that it would just work that way if I
> tried to do it, clearly not though). I can't tell for sure if the
> patch enables this behavior though or whether I would still get a
> Wrong type argument error.

This should work. Do you have reason for believing it might not?

For example, set:

(setq org-babel-default-header-args:bash
      `((:var . (lambda ()
                  "a='yay'"))))

Then in file.org:
#+begin_src bash :results output
echo $a
#+end_src

Executing this will yield:

#+RESULTS:
: yay

> [...] Looking
> at the patch it seems that it preserves the behavior of performing the
> evaluation of the closures at the source block, but I'm not 100% sure.

I'm not sure I completely understand what you mean here. However, the
closures are evaluated when point is at the source block, during the
source block evaluation, not when the default headers are declared. This
allows the closures to use context-dependent functionality (e.g. you can
call `org-element-at-point' inside the closure and retrieve whatever
information you want). Does this address your concern? Please clarify if
I've missed your point.

> If the default header closures are being evaluated before checking
> whether they have been superseded by the headers on a block then that
> is incorrect and they should not be evaluated until it is clear that
> they are the value of the header for that block and have not been
> superseded.

I've fixed my patch (attached) so that now closures are only evaluated
when they are used as part of the final set of headers.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-core.el-Add-ability-to-use-closures-as-default-he.patch --]
[-- Type: text/x-patch, Size: 4619 bytes --]

From 4a461a90ec4f3c5f9634b687a6685ea3ba74f168 Mon Sep 17 00:00:00 2001
From: Matt Huszagh <huszaghmatt@gmail.com>
Date: Fri, 28 Aug 2020 11:05:59 -0700
Subject: [PATCH] ob-core.el: Add ability to use closures as default header
 arguments

* lisp/ob-core.el (org-babel-default-header-args): Document ability to
use closures.
(org-babel-eval-headers): New function to generate header arguments,
which adds the ability to evaluate closures during source block
execution or export.
(org-babel-merge-params): Only evaluate closures when we have our
final list of headers.
---
 lisp/ob-core.el | 60 ++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 55 insertions(+), 5 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 578622232..bef34d7c0 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -473,7 +473,35 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
 (defvar org-babel-default-header-args
   '((:session . "none") (:results . "replace") (:exports . "code")
     (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
-  "Default arguments to use when evaluating a source block.")
+  "Default arguments to use when evaluating a source block.
+
+This is a list in which each element is an alist.  Each key
+corresponds to a header argument, and each value to that header's
+value.  The value can either be a string or a closure that
+evaluates to a string.  The closure is evaluated when the source
+block is being evaluated (e.g. during execution or export), with
+point at the source block.  It is not possible to use an
+arbitrary function symbol (e.g. 'some-func), since org uses
+lexical binding.  To achieve the same functionality, call the
+function within a closure (e.g. (lambda () (some-func))).
+
+To understand how closures can be used as default header
+arguments, imagine you'd like to set the file name output of a
+latex source block to a sha1 of its contents.  We could achieve
+this with:
+
+(defun org-src-sha ()
+  (let ((elem (org-element-at-point)))
+    (concat (sha1 (org-element-property :value elem)) \".svg\")))
+
+(setq org-babel-default-header-args:latex
+      `((:results . \"file link replace\")
+        (:file . (lambda () (org-src-sha)))))
+
+Because the closure is evaluated with point at the source block,
+the call to `org-element-at-point' above will always retrieve
+information about the current source block.")
+
 (put 'org-babel-default-header-args 'safe-local-variable
      (org-babel-header-args-safe-fn org-babel-safe-header-args))
 
@@ -584,6 +612,19 @@ the outer-most code block.")
 
 (defvar *this*)
 
+(defun org-babel-eval-headers (headers)
+  "Compute header list set with HEADERS.
+
+Evaluate all header arguments set to functions prior to returning
+the list of header arguments."
+  (let ((lst nil))
+    (dolist (elem headers)
+      (if (and (cdr elem)
+	       (functionp (cdr elem)))
+          (push `(,(car elem) . ,(funcall (cdr elem))) lst)
+        (push elem lst)))
+    lst))
+
 (defun org-babel-get-src-block-info (&optional light datum)
   "Extract information from a source block or inline source block.
 
@@ -2704,12 +2745,21 @@ parameters when merging lists."
 				  results-exclusive-groups
 				  results
 				  (split-string
-				   (if (stringp value) value (eval value t))))))
+				   (if (stringp value)
+				       value
+				     (if (functionp value)
+					 (funcall value)
+				       (eval value t)))))))
 	  (`(:exports . ,value)
 	   (setq exports (funcall merge
 				  exports-exclusive-groups
 				  exports
-				  (split-string (or value "")))))
+				  (split-string (or
+						 (if value
+						     (if (functionp value)
+							 (funcall value)
+						       value)
+						   ""))))))
 	  ;; Regular keywords: any value overwrites the previous one.
 	  (_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
     ;; Handle `:var' and clear out colnames and rownames for replaced
@@ -2724,14 +2774,14 @@ parameters when merging lists."
 			      (cdr (assq param params))))
 	  (setq params
 		(cl-remove-if (lambda (pair) (and (equal (car pair) param)
-					     (null (cdr pair))))
+						  (null (cdr pair))))
 			      params)))))
     ;; Handle other special keywords, which accept multiple values.
     (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
 			      (cons :exports (mapconcat #'identity exports " ")))
 			params))
     ;; Return merged params.
-    params))
+    (org-babel-eval-headers params)))
 
 (defun org-babel-noweb-p (params context)
   "Check if PARAMS require expansion in CONTEXT.
-- 
2.28.0