From 7a0b71fc519ec20b68ae75985085530750ad6e17 Mon Sep 17 00:00:00 2001
From: Mehmet Tekman <mtekman89@gmail.com>
Date: Wed, 20 Sep 2023 11:35:00 +0200
Subject: [PATCH 1/3] * lisp/ob-core.el (org-babel--split-str-quoted
 org-babel--tangle-split org-babel-process-params): functions to assist
 splitting a :tangle header containing a filename with spaces as well as a
 sync-action into two parameter components of strictly filename and
 sync-action for use with :tangle-params.

* lisp/ob-exp.el (org-babel-exp-code): fix to function to not include
:tangle-params as as real header

* testing/lisp/test-ob.el (test-ob/process-params-no-duplicates): fix
to include :tangle-params as part of process-params test
---
 lisp/ob-core.el         | 65 +++++++++++++++++++++++++++++++++++++----
 lisp/ob-exp.el          |  2 +-
 testing/lisp/test-ob.el |  2 ++
 3 files changed, 63 insertions(+), 6 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 73fb70c26..019f3d88d 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1785,6 +1785,52 @@ 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 header into two: filename of multiple words, and
+sync action. The result does not take into account any merged properties.
+
+If the filename is actually a tangle keyword such as 'no', then specify no sync action.
+
+Actions can be
+  :any (specific filename) import/export/sync
+  yes (inherited filename) import/export/sync
+  no (will not export) (no sync action)"
+  (let* ((valid-sync-actions '("import" "export" "sync"))
+         (file-action (org-babel--split-str-quoted raw-tangle))
+         (file (car file-action))
+         (sync-action (nth (1- (length file-action)) file-action)))
+    (if (member sync-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 a sync action was not given, and we default to normal tangle keywords
+      ;; such as a filename (assumes export), yes (assumes export), no (no sync-action)
+      (if (string-equal sync-action "no")
+          (setq sync-action nil)
+        ;; No sync action at all given? Assume the default: export
+        (setq sync-action "export"
+              file raw-tangle)))
+    (list file sync-action)))
+
+
 (defun org-babel-process-params (params)
   "Expand variables in PARAMS and add summary parameters."
   (let* ((processed-vars (mapcar (lambda (el)
@@ -1807,7 +1853,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 (cdr (assq :tangle params)))
+         (tangle-params (if raw-tangle
+                            (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
@@ -1815,14 +1867,17 @@ HEADER-ARGUMENTS is alist of all the arguments."
 			       (cadr  vars-and-names)))
       (cons :rowname-names (or (cdr (assq :rowname-names params))
 			       (cl-caddr vars-and-names)))
+      (cons :tangle-params tangle-params)  ;; always a list of two: tangle-keyword sync-action
       (cons :result-params result-params)
       (cons :result-type  (cond ((member "output" result-params) 'output)
 				((member "value" result-params) 'value)
-				(t 'value))))
+				(t 'value)))
+      )
      (cl-remove-if
-      (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
-					         :result-type :var)))
-      params))))
+      (lambda (x) (memq (car x) '(:colname-names :rowname-names :tangle-params
+                             :result-params :result-type
+                             :var)))
+       params))))
 
 ;; row and column names
 (defun org-babel-del-hlines (table)
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 80eaeeb27..05ac01c39 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -448,7 +448,7 @@ replaced with its value."
                            ;; Special parameters that are not real header
                            ;; arguments.
                            (memq (car pair)
-                                 '( :result-params :result-type
+                                 '( :result-params :result-type :tangle-params
                                     ;; This is an obsolete parameter still
                                     ;; used in some tests.
                                     :flags))
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index c088af7c8..e0de5a3ad 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -2131,10 +2131,12 @@ default-directory
 				      (:rowname-names)
 				      (:result-params)
 				      (:result-type)
+                                      (:tangle-params)
 				      (:var . "\"foo\"")))
 	  '((:var)
 	    (:colname-names)
 	    (:rowname-names)
+            (:tangle-params)
 	    (:result-params)
 	    (:result-type . value)))))
 
-- 
2.41.0