From 3fb2ed5ba09749e34b7b681cee0af7c971abee0d Mon Sep 17 00:00:00 2001 From: llcc Date: Fri, 4 Apr 2025 20:47:11 +0800 Subject: [PATCH] ob-tangle.el: Support tangling a source block to multiple targets * lisp/ob-tangle.el (org-babel-tangle--compute-targets): New function to compute multiple target file paths for a source block, supporting the new :tangle-directory header argument. (org-babel-tangle-collect-blocks): Refactor to handle the new nested list structure that supports multiple tangle targets per block. (org-babel-tangle-single-block): Modify to return a list of file-block pairs instead of a single pair, enabling multiple target support. (org-babel-tangle--unbracketed-link): Add guard for stringp check to handle list vaulues in :tangle parameter. * testing/lisp/test-ob-tangle.el (ob-tangle/collect-blocks): New test helper function and variable. (ob-tangle/collect-blocks): Extend tests to cover :tangle-directory header and multiple tangle targets. --- doc/org-manual.org | 44 +++++++++++++++-- etc/ORG-NEWS | 38 +++++++++++++++ lisp/ob-tangle.el | 86 ++++++++++++++++++++++++---------- testing/lisp/test-ob-tangle.el | 57 ++++++++++++++++++---- 4 files changed, 187 insertions(+), 38 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 5a4045271..384e5e009 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -19577,10 +19577,46 @@ to source file(s). - {{{var(FILENAME)}}} :: - Export the code block to source file whose file name is derived from - any string passed to the =tangle= header argument. Org derives the - file name as being relative to the directory of the Org file's - location. Example: =:tangle FILENAME=. + Export the code block to source file(s) whose file name(s) are + derived from the value passed to the =tangle= header argument. Org + derives the file names as being relative to the directory of the Org + file's location, or relative to the directory specified by the + =:tangle-directory= header argument if provided. + + The FILENAME can take several forms: + - A single file name (string) :: + + Example: =:tangle script.py=. + + - A list of file names :: + + Tangle the block to multiple files. Example: =:tangle + '("src/main.py" "src/utils.py")=. + + - A variable or function call :: + + Evaluate to get the target file name(s). Example: =:tangle + 'tangle-targets= or =:tangle (get-tangle-targets)=. + + When both =:tangle-directory= and multiple =:tangle= files are + specified, the block is tangled to all combinations of directories + and files. + + Example: + #+begin_src emacs-lisp :tangle '("config.el" "backup.el") :tangle-directory '("~/.config" "/backup") + (message "Tangling to multiple targets specified by :tangle and :tangle-directory") + #+end_src + + This tangles the block to four files: + - ~/.config/config.el + - ~/.config/backup.el + - /backup/config.el + - /backup/backup.el + +#+cindex: @samp{tangle-directory}, header argument +The =tangle-directory= header argument specifies one or more base +directories for relative tangle file paths. This works similarly to +=tangle= and accepts the same types of values. #+cindex: @samp{mkdirp}, header argument The =mkdirp= header argument creates parent directories for tangled diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 3f17e223e..699951add 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -243,6 +243,38 @@ When editing Dot source blocks, Org now uses Graphviz Dot mode, if installed. Org now officially enables C# code block evaluation based on the .NET SDK. +*** ob-tangle.el now supports tangling to multiple targets + +Source blocks can now be tangled to multiple target files using +the ~:tangle~ header argument. The following forms are now supported: + +- ~:tangle "file1.el"~ (existing behavior) +- ~:tangle '("file1.el" "file2.el")~ (new: list of files) +- ~:tangle (get-tangle-targets)~ (new: function returning paths) +- ~:tangle 'tangle-targets~ (new: variable returning paths) + +Additionally, the new ~:tangle-directory~ header argument specifies +base directories for relative tangle paths: + +- ~:tangle-directory "/tmp"~ (single directory) +- ~:tangle-directory '("/tmp/a" "/tmp/b")~ (multiple directories) +- ~:tangle-directory (get-tangle-dirs)~ (function returning directories) +- ~:tangle-directory 'tangle-dirs~ (variable returning directories) + +When both ~:tangle-directory~ and multiple ~:tangle~ files are specified, +the block is tangled to all combinations of directories and files. + +Example: +#+begin_src emacs-lisp :tangle '("config.el" "backup.el") :tangle-directory '("~/.config" "/backup") +(message "Tangling to multiple targets specified by :tangle and :tangle-directory") +#+end_src + +This tangles the block to four files: +- ~/.config/config.el +- ~/.config/backup.el +- /backup/config.el +- /backup/backup.el + ** New and changed options # Changes dealing with changing default values of customizations, @@ -519,6 +551,12 @@ accommodate even a single character of the headline, after accounting for spaces and the surrounding parentheses, it will omit the headline entirely and just show as much of the clock as fits under the limit. +*** New function ~org-babel-tangle--compute-targets~ + +The new function ~org-babel-tangle--compute-targets~ computes multiple +target file paths from ~:tangle~ and ~:tangle-directory~ header +arguments for a source block. + ** Removed or renamed functions and variables *** ~org-cycle-display-inline-images~ is renamed to ~org-cycle-display-link-previews~ diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 4c224743b..d8dab9bd5 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -73,7 +73,10 @@ then the name of the language is used." (string "File Extension")))) (defcustom org-babel-tangle-use-relative-file-links t - "Use relative path names in links from tangled source back the Org file." + "Use relative path names in links from tangled source back the Org file. + +Note that relative links are not used when a code block is tangled into +multiple target files." :group 'org-babel-tangle :type 'boolean) @@ -491,7 +494,6 @@ source code blocks by languages matching a regular expression. Optional argument TANGLE-FILE can be used to limit the collected code blocks by target file." (let ((counter 0) - (buffer-fn (buffer-file-name (buffer-base-buffer))) last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) (let ((current-heading-pos @@ -505,26 +507,22 @@ code blocks by target file." (setq last-heading-pos current-heading-pos))) (unless (or (org-in-commented-heading-p) (org-in-archived-heading-p)) - (let* ((info (org-babel-get-src-block-info 'no-eval)) - (src-lang (nth 0 info)) - (src-tfile (cdr (assq :tangle (nth 2 info))))) - (unless (or (string= src-tfile "no") - ;; src block without lang - (and (not src-lang) (string= src-tfile "yes")) - (and tangle-file (not (equal tangle-file src-tfile))) - ;; lang-re but either no lang or lang doesn't match - (and lang-re - (or (not src-lang) - (not (string-match-p lang-re src-lang))))) - ;; Add the spec for this block to blocks under its tangled - ;; file name. - (let* ((block (org-babel-tangle-single-block counter)) - (src-tfile (cdr (assq :tangle (nth 4 block)))) - (file-name (org-babel-effective-tangled-filename - buffer-fn src-lang src-tfile)) - (by-fn (assoc file-name blocks))) - (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) - (push (cons file-name (list (cons src-lang block))) blocks))))))) + (dolist (block (org-babel-tangle-single-block counter t)) + (let ((src-file (car block)) + (src-lang (caadr block))) + (unless (or (not src-file) + ;; src block without lang + (and (not src-lang) src-file) + (and tangle-file (not (equal tangle-file src-file))) + ;; lang-re but either no lang or lang doesn't match + (and lang-re + (or (not src-lang) + (not (string-match-p lang-re src-lang))))) + (setq blocks + (mapcar (lambda (group) + (cons (car group) + (apply #'append (mapcar #'cdr (cdr group))))) + (seq-group-by #'car (push block blocks))))))))) ;; Ensure blocks are in the correct order. (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) (nreverse blocks)))) @@ -541,6 +539,7 @@ The PARAMS are the 3rd element of the info for the same src block." (match-string 1 l)))) (when bare (if (and org-babel-tangle-use-relative-file-links + (stringp (cdr (assq :tangle params))) (string-match org-link-types-re bare) (string= (match-string 1 bare) "file")) (concat "file:" @@ -550,6 +549,41 @@ The PARAMS are the 3rd element of the info for the same src block." bare)))))) (defvar org-outline-regexp) ; defined in lisp/org.el + +(defun org-babel-tangle--compute-targets (buffer-fn info) + "Compute the list of target file paths for tangling a source block. + +BUFFER-FN is the absolute file name of the source buffer. INFO is the +source block information, as returned by `org-babel-get-src-block-info'." + (let* ((params (nth 2 info)) + (lang (nth 0 info)) + (tangle-dir-raw (cdr (assq :tangle-directory params))) + (tangle-targets (cdr (assq :tangle params))) + (tangle-dirs (ensure-list tangle-dir-raw)) + (tangle-files + (cond + ((and (stringp tangle-targets) (string= tangle-targets "yes")) + ;; Default to buffer name if :tangle yes + (list (file-name-nondirectory + (org-babel-effective-tangled-filename buffer-fn lang tangle-targets)))) + ((and (stringp tangle-targets) (string= tangle-targets "no")) nil) + (t (ensure-list tangle-targets))))) + + (when tangle-files + (setq tangle-files + (cl-loop for file in tangle-files append + (if (file-name-absolute-p file) + (list file) ;; absolute paths stay as is + (if tangle-dirs + (mapcar (lambda (dir) (expand-file-name file dir)) tangle-dirs) + (list file)))))) + + ;; Normalize final paths + (cl-remove-duplicates + (mapcar (lambda (file) + (org-babel-effective-tangled-filename buffer-fn lang file)) + tangle-files)))) + (defun org-babel-tangle-single-block (block-counter &optional only-this-block) "Collect the tangled source for current block. Return the list of block attributes needed by @@ -616,7 +650,6 @@ non-nil, return the full association list to be used by (match-end 0) (point-min)))) (point))))) - (src-tfile (cdr (assq :tangle params))) (result (list start-line (if org-babel-tangle-use-relative-file-links @@ -629,9 +662,10 @@ non-nil, return the full association list to be used by (org-trim (org-remove-indentation body))) comment))) (if only-this-block - (let* ((file-name (org-babel-effective-tangled-filename - file src-lang src-tfile))) - (list (cons file-name (list (cons src-lang result))))) + (let* ((file-names (org-babel-tangle--compute-targets file info))) + (mapcar (lambda (file-name) + (cons file-name (list (cons src-lang result)))) + file-names)) result))) (defun org-babel-tangle-comment-links (&optional info) diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el index cd6876370..ec377b344 100644 --- a/testing/lisp/test-ob-tangle.el +++ b/testing/lisp/test-ob-tangle.el @@ -583,6 +583,14 @@ another block (set-buffer-modified-p nil)) (kill-buffer buffer)))) +(defun ob-tangle/tangle-targets () + "Return tangle targets for testing." + '("relative.el" "/tmp/absolute.el")) + +(defvar ob-tangle/tangle-targets + '("relative.el" "/tmp/absolute.el") + "Tangle targets variable for testing.") + (ert-deftest ob-tangle/collect-blocks () "Test block collection into groups for tangling." (org-test-with-temp-text-in-file "" ; filled below, it depends on temp file name @@ -632,6 +640,18 @@ another block \"H1: no language and inherited :tangle relative.el in properties\" #+end_src +#+begin_src emacs-lisp :tangle '(\"relative.el\" \"/tmp/absolute.el\") +\"H1: :tangle relative.el and /tmp/absolute.el\" +#+end_src + +#+begin_src emacs-lisp :tangle 'ob-tangle/tangle-targets +\"H1: :tangle relative.el and /tmp/absolute.el\" +#+end_src + +#+begin_src emacs-lisp :tangle (ob-tangle/tangle-targets) +\"H1: :tangle relative.el and /tmp/absolute.el\" +#+end_src + * H2 without :tangle in properties #+begin_src emacs-lisp @@ -668,7 +688,19 @@ another block #+begin_src \"H2: without language and thus without :tangle\" -#+end_src" +#+end_src + +* H3 with :tangle-directory + +#+begin_src emacs-lisp :tangle-directory /tmp/a :tangle '(\"foo.el\" \"bar.el\") :mkdirp yes +\"H3: :tangle /tmp/foo.el and /tmp/bar.el\" +#+end_src + +#+begin_src emacs-lisp :tangle-directory '(\"/tmp/a\" \"/tmp/b\") :tangle '(\"foo.el\" \"bar.el\") :mkdirp yes +\"H3: :tangle /tmp/a/foo.el, /tmp/a/bar.el, /tmp/b/foo.el and /tmp/b/bar.el\" +#+end_src + +" `((?a . ,el-file-abs) (?r . ,el-file-rel)))) ;; We check the collected blocks to tangle by counting equal @@ -691,10 +723,15 @@ another block ;; From `org-babel-tangle-collect-blocks'. collected-blocks))))) (should (equal (funcall normalize-expected-targets-alist - `(("/tmp/absolute.el" . 4) - ("relative.el" . 6) + `(("/tmp/absolute.el" . 7) + ("/tmp/a/foo.el" . 2) + ("/tmp/a/bar.el" . 2) + ("/tmp/b/foo.el" . 1) + ("/tmp/b/bar.el" . 1) + ("relative.el" . 8) ;; file name differs between tests - (,el-file-abs . 4))) + (,el-file-abs . 4) + )) (funcall count-blocks-in-target-files (org-babel-tangle-collect-blocks)))) ;; Simulate TARGET-FILE to test as `org-babel-tangle' and @@ -706,12 +743,16 @@ another block (list (cons :tangle el-file-abs))))) (should (equal (funcall normalize-expected-targets-alist - `(("/tmp/absolute.el" . 4) - ("relative.el" . 6) + `(("/tmp/absolute.el" . 7) + ("/tmp/a/foo.el" . 2) + ("/tmp/a/bar.el" . 2) + ("/tmp/b/foo.el" . 1) + ("/tmp/b/bar.el" . 1) + ("relative.el" . 8) ;; Default :tangle header now also ;; points to the file name derived from the name of - ;; the Org file, so 6 blocks should go there. - (,el-file-abs . 6))) + ;; the Org file, so 5 blocks should go there. + (,el-file-abs . 5))) (funcall count-blocks-in-target-files (org-babel-tangle-collect-blocks))))))))) -- 2.50.1 (Apple Git-155)