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

[Mehmet Tekman]

Ihor Radchenko <yantar92@posteo.net> writes:

> Mehmet Tekman <mtekman89@gmail.com> writes:
>
>> Okay, I will definitely need to refactor my patches then, but I'm
>> quite happy with the state of my current patch branch, so it will
>> be an additional patch instead of a brand new set of patches
>> I think.
>
> It has been a while since the most recent message in this thread.
> May I know if you need any further help with the patch?
>

Hey, thanks for reaching out.

No, I know what to do -- it's just finding the time to do it that is
proving difficult.

I made some small edits a few months ago, to reform the header arguments
so that tangle actions would be encoded in the `:tangle-params' header
and would largely leave the `:tangle' header alone… but when I tested
it, it was failing all tests for reasons I wasn't to sure about.

Here is the current state of my header-reform branch:

>From 9ba64d149aac6c807e233e34474ffe022488efe6 Mon Sep 17 00:00:00 2001
From: Mehmet Tekman <mtekman89@gmail.com>
Date: Wed, 20 Sep 2023 11:35:00 +0200
Subject: [PATCH] header refs

---
 lisp/ob-core.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 46 insertions(+), 2 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index a7c4f2cab..0b0d1c18c 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1753,6 +1753,42 @@ HEADER-ARGUMENTS is alist of all the arguments."
          header-arguments)
     (nreverse results)))
 
+
+(defun org-babel--split-str-quoted (str)
+  "Splits a string that may or may not contain quotes."
+  (let (result pos)
+    (while (string-match (rx (or (seq "\"" (group (* (not "\""))) "\"")
+                                 (group (+ (not space)))))
+                         str pos)
+      (let ((match-str1 (match-string 1 str))
+            (match-str2 (match-string 2 str)))
+        (if match-str1
+            (progn
+              (push match-str1 result)
+              (setq pos (1+ (match-end 1))))
+          (push match-str2 result)
+          (setq pos (match-end 2)))))
+    (nreverse result)))
+
+(defun org-babel--tangle-split (raw-tangle)
+  "Split a :tangle headerby filename and sync action."
+  (let* ((valid-sync-actions '("import" "export" "sync"))
+         (file-action (org-babel--split-str-quoted raw-tangle))
+         (file (car file-action))
+         (action (nth (1- (length file-action)) file-action)))
+    (if (member action valid-sync-actions)
+        ;; If last word matches, assume the previous are all part of
+        ;; the filename
+        (setq file (mapconcat #'identity (nreverse (cdr (nreverse 
file-action))) " "))
+      ;; Otherwise set the default action and assume that the full
+      ;; string has no action
+      (if (or file action)
+          (setq action "export"
+                file (read-char raw-tangle))))
+    (if (or file action)
+        (list file action)
+      (list nil))))
+
 (defun org-babel-process-params (params)
   "Expand variables in PARAMS and add summary parameters."
   (let* ((processed-vars (mapcar (lambda (el)
@@ -1775,7 +1811,13 @@ HEADER-ARGUMENTS is alist of all the arguments."
                                            raw-result
                                           ;; FIXME: Arbitrary code evaluation.
                                          (eval raw-result t)))
-                         (cdr (assq :result-params params))))))
+                         (cdr (assq :result-params params)))))
+         (raw-tangle (or (cdr (assq :tangle params)) ""))
+         (tangle-params (delete-dups
+                        (append
+                         (org-babel--tangle-split raw-tangle)
+                         (cdr (assq :tangle-params params)))))
+         )
     (append
      (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
      (list
@@ -1786,7 +1828,9 @@ HEADER-ARGUMENTS is alist of all the arguments."
       (cons :result-params result-params)
       (cons :result-type  (cond ((member "output" result-params) 'output)
                                ((member "value" result-params) 'value)
-                               (t 'value))))
+                               (t 'value)))
+      (cons :tangle-params tangle-params)
+      )
      (cl-remove-if
       (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
                                                 :result-type :var)))
-- 
2.42.1

If you have any insight into why the tests are failing, I'd greatly
appreciate it.

Best,
Mehmet