Re: [ANN] lisp/ob-tangle-sync.el

[Mehmet Tekman <mtekman89@gmail.com>]

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


Ihor Radchenko <yantar92@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.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Exclusive values for TANGLE header arguments added to the `org-babel-common-header-args-w-values' constant, along with a dedicated function `org-babel--handle-tangle-args' which parses it to conform to a `:tangle <filename action> <sync action>' format. --]
[-- Type: text/x-patch, Size: 4013 bytes --]

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

[-- Attachment #3: Toy example file --]
[-- Type: text/plain, Size: 721 bytes --]

#+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