From 3a04df5e636c11bfcd8e2183e4a3e336daeb46a9 Mon Sep 17 00:00:00 2001 From: Jacopo De Simoi Date: Fri, 2 Jul 2021 18:31:41 -0400 Subject: [PATCH 1/2] ob-tangle: Accept lists of files as tangling target * lisp/ob-tangle.el (org-babel-tangle): Drop the now superfluous parameter `only-this-block'. (org-babel-effective-tangled-filenames): Return a list of filenames to use as targets for tangling. (org-babel-tangle-collect-blocks): Adapt to changes to `org-babel-tangle-single-block', which now returns an alist. (org-babel-tangle-single-block): Return an alist to be used from `org-babel-tangle'. A single block can now be tangled to several files at once. This commit correctly parses list of filenames as arguments of the :tangle parameter. In doing so it streamlines both `org-babel-tangle-single-block' and `org-babel-tangle-collect-blocks'. This was inspired by the solution to the question [https://emacs.stackexchange.com/questions/39032/tangle-the-same-src-block-to-different-files] which I asked few years ago. The suggested solution does not work with recent org-mode, so I came up with a working rewrite. --- lisp/ob-tangle.el | 88 ++++++++++++++++++++++++----------------------- 1 file changed, 45 insertions(+), 43 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 2f60ef9a4..3799da03f 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -275,7 +275,7 @@ matching a regular expression." (mapc (lambda (mode) (set-file-modes file-name mode)) modes) (push file-name path-collector)))))) (if (equal arg '(4)) - (org-babel-tangle-single-block 1 t) + (org-babel-tangle-single-block 1) (org-babel-tangle-collect-blocks lang-re tangle-file))) (message "Tangled %d code block%s from %s" block-counter (if (= block-counter 1) "" "s") @@ -350,22 +350,24 @@ that the appropriate major-mode is set. SPEC has the form: (org-fill-template org-babel-tangle-comment-format-end link-data))))) -(defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile) - "Return effective tangled filename of a source-code block. +(defun org-babel-effective-tangled-filenames (buffer-fn src-lang src-tfile) + "Return a list of effective tangled filename of a source-code block. BUFFER-FN is the name of the buffer, SRC-LANG the language of the block and SRC-TFILE is the value of the :tangle header argument, as computed by `org-babel-tangle-single-block'." - (let ((base-name (cond + (if (consp src-tfile) + src-tfile + (list (let ((base-name (cond ((string= "yes" src-tfile) ;; Use the buffer name (file-name-sans-extension buffer-fn)) ((string= "no" src-tfile) nil) ((> (length src-tfile) 0) src-tfile))) (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) - (when base-name + (when base-name ;; decide if we want to add ext to base-name (if (and ext (string= "yes" src-tfile)) - (concat base-name "." ext) base-name)))) + (concat base-name "." ext) base-name)))))) (defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file) "Collect source blocks in the current Org file. @@ -388,27 +390,26 @@ be used to limit the collected code blocks by target file." (let* ((info (org-babel-get-src-block-info 'light)) (src-lang (nth 0 info)) (src-tfile (cdr (assq :tangle (nth 2 info))))) - (unless (or (string= src-tfile "no") + (unless (or (and (not (consp src-tfile)) (string= src-tfile "no")) (and tangle-file (not (equal tangle-file src-tfile))) (and lang-re (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 - (nth 1 block) 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))))))) + (let ((new-blocks (org-babel-tangle-single-block counter))) + (dolist (bl new-blocks) + (let* ((block (cdr bl)) + (file-name (car bl)) + (by-fn (assoc file-name blocks))) + (if by-fn (setcdr by-fn (cons (car block) (cdr by-fn))) + (push (cons file-name block) blocks))))))))) ;; Ensure blocks are in the correct order. (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) (nreverse blocks)))) -(defun org-babel-tangle-single-block (block-counter &optional only-this-block) +(defun org-babel-tangle-single-block (block-counter) "Collect the tangled source for current block. -Return the list of block attributes needed by -`org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is -non-nil, return the full association list to be used by +Return the association list of blocks needed by +`org-babel-tangle-collect-blocks' or `org-babel-tangle' directly." (let* ((info (org-babel-get-src-block-info)) (start-line @@ -470,31 +471,32 @@ non-nil, return the full association list to be used by (match-end 0) (point-min)))) (point))))) - (result - (list start-line - (if org-babel-tangle-use-relative-file-links - (file-relative-name file) - file) - (if (and org-babel-tangle-use-relative-file-links - (string-match org-link-types-re link) - (string= (match-string 1 link) "file")) - (concat "file:" - (file-relative-name (substring link (match-end 0)) - (file-name-directory - (cdr (assq :tangle params))))) - link) - source-name - params - (if org-src-preserve-indentation - (org-trim body t) - (org-trim (org-remove-indentation body))) - comment))) - (if only-this-block - (let* ((src-tfile (cdr (assq :tangle (nth 4 result)))) - (file-name (org-babel-effective-tangled-filename - (nth 1 result) src-lang src-tfile))) - (list (cons file-name (list (cons src-lang result))))) - result))) + (src-tfile (cdr (assq :tangle params))) + (file-names (org-babel-effective-tangled-filenames + (if org-babel-tangle-use-relative-file-links + (file-relative-name file) + file) src-lang src-tfile))) + (mapcar (lambda (file-name) + (cons file-name (list (cons src-lang + (list start-line + (if org-babel-tangle-use-relative-file-links + (file-relative-name file) + file) + (if (and org-babel-tangle-use-relative-file-links + (string-match org-link-types-re link) + (string= (match-string 1 link) "file")) + (concat "file:" + (file-relative-name (substring link (match-end 0)) + (file-name-directory + file-name))) + link) + source-name + params + (if org-src-preserve-indentation + (org-trim body t) + (org-trim (org-remove-indentation body))) + comment))))) + file-names))) (defun org-babel-tangle-comment-links (&optional info) "Return a list of begin and end link comments for the code block at point. -- 2.31.1