Ihor Radchenko <yanta...@posteo.net> writes:
> Yes. See `org-babel-common-header-args-w-values'. In particular, take a
> look at (results ...).
Thanks, it took me some time to get my head around how to use this.
> I now ported a bit of documentation from my refactor branch.
> See https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=f268819d1
I'm having some problems getting:
`:tangle <tangle/yes/no/<filename>> [import/export/both/skip]'
to work nicely with the existing framework. The main issue lies in the
`:any` keyword in `org-babel-common-header-args-w-values' for the tangle
entry making it difficult to determine where one exclusionary group
begins and where the other ends.
e.g.
(defconst org-babel-common-header-args-w-values
...
(tangle . ((tangle yes no :any)
(import export skip sync)))
...
)
If I remove the :any keyword, these two groups work with the existing
framework in `org-babel-merge-params', but this would then mean that the
first tangle argument can't just be a filename string. I can get around
it by changing `:any' to `file' and then letting users describe their
tangle headers via e.g. `:tangle file import file: /some/file' but this
would be a breaking change.
In the meantime I put together a hacky solution that parses the tangle
header independently (`org-babel--handle-tangle-args') with the aim that
the first argument should ideally define a tangle filename action and
the second argument should ideally define a tangle sync action.
Please see the attached minor patch (diff) and a toy org example file.
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 65fa47ab5..026788c00 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -431,7 +431,8 @@ then run `org-babel-switch-to-session'."
(sep . :any)
(session . :any)
(shebang . :any)
- (tangle . ((tangle yes no :any)))
+ (tangle . ((tangle yes no :any)
+ (import export skip sync)))
(tangle-mode . ((#o755 #o555 #o444 :any)))
(var . :any)
(wrap . :any)))
@@ -2802,6 +2803,9 @@ parameters when merging lists."
(exports-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
(cdr (assq 'exports org-babel-common-header-args-w-values))))
+ (tangle-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assq 'tangle org-babel-common-header-args-w-values))))
(merge
(lambda (exclusive-groups &rest result-params)
;; Maintain exclusivity of mutually exclusive parameters,
@@ -2821,7 +2825,7 @@ parameters when merging lists."
params ;Final parameters list.
;; Some keywords accept multiple values. We need to treat
;; them specially.
- vars results exports)
+ vars results exports tangle)
(dolist (plist plists)
(dolist (pair plist)
(pcase pair
@@ -2872,6 +2876,12 @@ parameters when merging lists."
(cond ((and value (functionp value)) (funcall value))
(value value)
(t ""))))))
+ (`(:tangle . ,value)
+ (setq tangle (funcall merge
+ tangle-exclusive-groups
+ tangle
+ (split-string
+ (or value "")))))
((or '(:dir . attach) '(:dir . "'attach"))
(unless (org-attach-dir nil t)
(error "No attachment directory for element (add :ID: or :DIR: property)"))
@@ -2897,11 +2907,38 @@ parameters when merging lists."
params)))))
;; Handle other special keywords, which accept multiple values.
(setq params (nconc (list (cons :results (mapconcat #'identity results " "))
- (cons :exports (mapconcat #'identity exports " ")))
+ (cons :exports (mapconcat #'identity exports " "))
+ (cons :tangle (org-babel--handle-tangle-args tangle)))
params))
;; Return merged params.
(org-babel-eval-headers params)))
+(defun org-babel--handle-tangle-args (tangle)
+ "Sanitize tangle arguments.
+From the list of TANGLE parameters, assert that that there are at
+maximum only two elements in the following preferential order:
+the first element relates to a filename descriptor (such as a
+path, `tangle', `yes', or `no'); the second element relates to a
+valid sync direction."
+ (let* ((num-args (length tangle))
+ ;; Extract valid mutex groups
+ (valid-tangle-headers (cdr (assoc 'tangle
+ org-babel-common-header-args-w-values)))
+ (valid-fname-args (seq-remove (lambda (x) (equal :any x)) (car valid-tangle-headers)))
+ (valid-sync-args (cadr valid-tangle-headers))
+ ;; Attempt to split TANGLE by these mutex groups
+ (sync-arg (seq-filter (lambda (x) (member (intern x) valid-sync-args)) tangle))
+ (fname-arg (seq-remove (lambda (x) (member x sync-arg)) tangle))
+ ;; Search for a potential filename
+ (filename (seq-remove (lambda (x) (member (intern x) valid-fname-args)) fname-arg)))
+ (setq sync-arg (car sync-arg)
+ ;; Assumption: the last added tangle argument is more
+ ;; important than the one preceding it.
+ fname-arg (or (car filename)
+ (car fname-arg)))
+ (concat fname-arg (if sync-arg " " "" ) sync-arg)))
+
+
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
#+TITLE: Sync test
#+PROPERTY: header-args :tangle /tmp/default_tangle.txt
Running =(assoc :tangle (nth 2 (org-babel-get-src-block-info)))= on
each of these should yield:
#+begin_src conf
(:tangle . /tmp/default_tangle.txt)
#+end_src
#+begin_src conf :tangle skip
(:tangle . /tmp/default_tangle.txt skip)
#+end_src
#+begin_src conf :tangle randomfile sync
(:tangle . randomfile sync)
#+end_src
#+begin_src conf :tangle randomfile
(:tangle . randomfile)
#+end_src
#+begin_src conf :tangle import export
## Ignores import
(:tangle . /tmp/default_tangle.txt export)
#+end_src
#+begin_src conf :tangle fname1 fname2 sync export
## Ignores fname1 and sync
(:tangle . fname2 export)
#+end_src
