emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Phil <pe@7d.nz>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: emacs-orgmode@gnu.org
Subject: Re: [FR] org-babel-n-tangle
Date: Mon, 15 Jul 2024 07:12:31 +0200	[thread overview]
Message-ID: <d33e3ce8-c379-46d6-9729-aa6bd121ba03@7d.nz> (raw)
In-Reply-To: <87ed7y4zwu.fsf@localhost>

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


* [2024-07-12 13:23] Ihor Radchenko:> Phil <pe@7d.nz> writes:
>> To tangle to multiple destinations
>
> a logic extension of the existing tangle mechanism.
> 1) Introduce :tangle-directory parameter that defines
>    relative directory to be used as tangle target; this
>    directory, if defined, will be used instead of the Org
>    file directory to expand the tangle target;
> 2) Allow :tangle-directory and :tangle-file to be a list
>    of targets to write.
>
> Then, we can modify `org-babel-effective-tangled-filename'
> to account for :tangle directory and modify
> `org-babel-tangle' (as you did) to write to multiple
> targets.

All right. So I have it working for single blocks by
modifying only `org-babel-tangle' with :tangle-directory
accepting a single string or a list, e.g.

:tangle-directory '("dir1" "/ssh:host1:/dir2" "/-::/etc")

The option is ignored for file-wide tangle.

What do you think of, instead of adding :tangle-directory,
modifying :tangle to make it accept also a list?

Since I may not get back to this in the next weeks,
I'm saving the following note and a patch as a current
status of the function for later.

=:tangle-directory dir= is set
- Tangle globally
       |--------+------------------+--------------|
       | tangle | expected result  | current      |
       |--------+------------------+--------------|
       | yes    |             ignore dir          |
       | no     |             ignore dir          |
       | file   | block → dir/file?| block → file |
       |--------+------------------+--------------|
- Tangle a single block
       |--------+------------------+---------------------------|
       | tangle | expected result  | current                   |
       |--------+------------------+---------------------------|
       | yes    | ?                | dir/[org-folder/org-file] |
       | no     | error?           | dir (as file or folder)   |
       | file   | tangle to TD+dir | tangle to TD+dir          |
       |--------+------------------+---------------------------|

Cheers,

Phil

[-- Attachment #2: 0001-add-header-arg-tangle-directory.patch --]
[-- Type: text/x-patch, Size: 5461 bytes --]

From 360938b43a9c6a731114840c9b6db7c79f786116 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Sat, 13 Jul 2024 14:46:08 +0200
Subject: [PATCH] add header-arg :tangle-directory declares a directory or a
 list of directories as parent(s) to the :tangle argument

---
 lisp/ob-tangle.el              | 16 ++++++--
 testing/lisp/test-ob-tangle.el | 72 +++++++++++++++++++++++++++++++++-
 2 files changed, 84 insertions(+), 4 deletions(-)

diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index c89763efa..c494571dc 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -269,11 +269,20 @@ matching a regular expression."
 	     (when (equal arg '(16))
 	       (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval))))
 		   (user-error "Point is not in a source code block"))))
+            (dirs (cdr (assq :tangle-directory (nth 2 (org-babel-get-src-block-info)))))
 	    path-collector
-            (source-file buffer-file-name))
-	(mapc ;; map over file-names
+      (source-file buffer-file-name))
+
+        (setq dirs (cl-case (type-of dirs)
+                     (string (list dirs))
+                     (cons dirs)
+                     (symbol '(nil))))
+
+	(dolist (dir dirs) ; iterate the n-tangle group
+          (progn
+	(mapc ; map over directories
 	 (lambda (by-fn)
-	   (let ((file-name (car by-fn)))
+	   (let ((file-name (concat dir (car by-fn))))
 	     (when file-name
                (let ((lspecs (cdr by-fn))
 		     (fnd (file-name-directory file-name))
@@ -354,6 +363,7 @@ matching a regular expression."
 	 (if (equal arg '(4))
 	     (org-babel-tangle-single-block 1 t)
 	   (org-babel-tangle-collect-blocks lang-re tangle-file)))
+        ))
 	(message "Tangled %d code block%s from %s" block-counter
 		 (if (= block-counter 1) "" "s")
 		 (file-name-nondirectory
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index e13bca0cb..a725cdb14 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -27,6 +27,7 @@
 
 (require 'subr-x)
 (require 'ob-tangle)
+(require 'find-file)
 (require 'org)
 
 ;; TODO
@@ -660,7 +661,13 @@ another block
 
 #+begin_src emacs-lisp :tangle ~/../../tmp/absolute.el
 \"H2: :tangle ~/../../tmp/absolute.el\"
-#+end_src"
+#+end_src
+
+#+begin_src emacs-lisp :tangle-directory '(\"/tmp/a/\" \"tmp/b/\") :tangle multiple.el
+\"H2: :tangle /tmp/multiple.el\"
+#+end_src
+
+"
                     `((?a . ,el-file-abs)
                       (?r . ,el-file-rel))))
       ;; We check the collected blocks to tangle by counting equal
@@ -699,6 +706,7 @@ another block
           (should (equal
                    (funcall normalize-expected-targets-alist
                             `(("/tmp/absolute.el" . 4)
+                              ("/tmp/multiple.el" . 1)
                               ("relative.el" . 5)
                               ;; Default :tangle header now also
                               ;; points to the file name derived from the name of
@@ -707,6 +715,68 @@ another block
                    (funcall count-blocks-in-target-files
                             (org-babel-tangle-collect-blocks)))))))))
 
+(ert-deftest ob-tangle/directory ()
+  "Test if ob-tangle/directory works correctly for one directory."
+  (should
+   (equal '("1")
+          (let* (
+                 (dir (make-temp-file "org-tangle-dir-test-" t))
+                 (filename (md5(format "%s" (current-time))))
+                 (file (concat dir "/" filename))
+                 )
+            (unwind-protect
+                (progn
+                  (org-test-with-temp-text-in-file
+                      (format "
+#+begin_src elisp :tangle-directory %s :tangle /%s <point>
+1
+#+end_src
+" dir filename)
+                    (let ((org-babel-noweb-error-all-langs nil)
+                          (org-babel-noweb-error-langs nil))
+                      (org-babel-tangle '(4))))
+
+                    (with-temp-buffer
+                      (insert-file-contents file)
+                      (org-split-string (buffer-string))))
+
+            (delete-file file)))
+          )))
+
+
+(ert-deftest ob-tangle/multiple-directories ()
+  "Test if ob-tangle/directory works correctly for multiple directory."
+  (should
+   (equal '("1" "1")
+          (let* (
+                 (dir1 (make-temp-file "org-tangle-dir-test-" t))
+                 (dir2 (make-temp-file "org-tangle-dir-test-" t))
+                 (filename (md5(format "%s" (current-time))))
+                 (file1 (concat dir1 "/" filename))
+                 (file2 (concat dir2 "/" filename))
+                 )
+            (unwind-protect
+                (progn
+                  (org-test-with-temp-text-in-file
+                      (format "
+#+begin_src elisp :tangle-directory '(\"%s\" \"%s\") :tangle /%s <point>
+1
+#+end_src
+" dir1 dir2 filename)
+                    (let ((org-babel-noweb-error-all-langs nil)
+                          (org-babel-noweb-error-langs nil))
+                      (org-babel-tangle '(4))))
+
+                    (with-temp-buffer
+                      (insert-file-contents file1)
+                      (insert-file-contents file2)
+                      (org-split-string (buffer-string))))
+              (progn
+                (delete-file file1)
+                (delete-file file2))))
+          )))
+
+
 (provide 'test-ob-tangle)
 
 ;;; test-ob-tangle.el ends here
-- 
2.39.2


  reply	other threads:[~2024-07-15  5:13 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2024-07-12  7:11 [FR] org-babel-n-tangle Phil
2024-07-12 11:23 ` Ihor Radchenko
2024-07-15  5:12   ` Phil [this message]
2024-07-15 14:28     ` Ihor Radchenko

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=d33e3ce8-c379-46d6-9729-aa6bd121ba03@7d.nz \
    --to=pe@7d.nz \
    --cc=emacs-orgmode@gnu.org \
    --cc=yantar92@posteo.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).