Orgmode: how to filter the blocks to be tangle?

Question

In Orgmode, is there a way to tangle just the blocks in subtree matching (or not matching) a specific tag?

For instance with the following code

* A
#+BEGIN_SRC c
   printf("Not exported");
#+END_SRC

* B                :D:

#+BEGIN_SRC c
  printf("Exported");
#+END_SRC

exporting along tag D, the tangle C file will only contains printf("Exported");

I'm using org-mode to organise my emacs config, and my goal is to derive different configs from the master one emacs-config.org. (for instance a lightconfig by marking just the specific)

Ricotta

Answer 1

To achieve this behavior you can make use of the fact that aside from yes and no, the :tangle header argument for Org Babel code blocks also understands file names; i.e., for any given code block you can tell Org Babel which file you would like the block to be tangled to. My idea is to automatically set the file name for each code block under a certain headline when adding a tag to the headline:

(defun org-babel-set-tangle-file ()
  (let ((tag (car (org-get-local-tags))))
    (org-narrow-to-subtree)
    (while (re-search-forward "\\(:tangle \\).*" nil t)
      (replace-match (concat "\\1" tag ".el")))
    (widen)))

(add-hook 'org-after-tags-change-hook 'org-babel-set-tangle-file)

The resulting behavior is that when you call org-babel-tangle for the current file, all code blocks belonging to

• headlines without a tag will be tangled to the default tangle file(s)
• a tagged headline will be tangled to a file named after the tag.

Note that the function above sets the file extension of tag-specific tangle files to .el; since you mention that you would like to produce different Emacs configurations I figured that would be a reasonable default (even though you are showing C code in your example).

Stalinsk

I've just try but didn't really work as expected. (since you are excepting that there is :tangle tag, and I prefer not to add the to all the block ) I prefer mike idea to filter the collected block. feels more flexible, and can had more logic behin it – Ricotta

Answer 2

I tried researching this a while ago and found no quick answer. I ended up modifying org-babel-tangle-collect-blocks to implement this functionality

Here is the modified function. The list org-babel-tags is a list of ok tags. For your example, you need to set it with (setq org-babel-tags '("D"))

(I added the first 4 lines after the first call to 'unless')

(defvar org-babel-tags nil
  "only tangle entries that has a tag in this list")

(defun org-babel-tangle-collect-blocks (&optional language)
  "Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANG can be used to limit the collected source
code blocks by language."
  (let ((block-counter 1) (current-heading "") blocks)
    (org-babel-map-src-blocks (buffer-file-name)
      ((lambda (new-heading)
         (if (not (string= new-heading current-heading))
             (progn
               (setq block-counter 1)
               (setq current-heading new-heading))
           (setq block-counter (+ 1 block-counter))))
       (replace-regexp-in-string "[ \t]" "-"
                                 (condition-case nil
                                     (or (nth 4 (org-heading-components))
                                         "(dummy for heading without text)")
                                   (error (buffer-file-name)))))
      (let* ((start-line (save-restriction (widen)
                                           (+ 1 (line-number-at-pos (point)))))
             (file (buffer-file-name))
             (info (org-babel-get-src-block-info 'light))
             (src-lang (nth 0 info)))
        (unless (or (string= (cdr (assoc :tangle (nth 2 info))) "no")
                    (null (intersection (mapcar 'intern org-babel-tags)
                                        (save-excursion
                                          (org-back-to-heading)
                                          (mapcar 'intern (org-get-tags))))))

                    (unless (and language (not (string= language src-lang)))
                      (let* ((info (org-babel-get-src-block-info))
                             (params (nth 2 info))
                             (extra (nth 3 info))
                             (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
                                                (match-string 1 extra))
                                           org-coderef-label-format))
                             (link ((lambda (link)
                                      (and (string-match org-bracket-link-regexp link)
                                           (match-string 1 link)))
                                    (org-no-properties
                                     (org-store-link nil))))
                             (source-name
                              (intern (or (nth 4 info)
                                          (format "%s:%d"
                                                  current-heading block-counter))))
                             (expand-cmd
                              (intern (concat "org-babel-expand-body:" src-lang)))
                             (assignments-cmd
                              (intern (concat "org-babel-variable-assignments:" src-lang)))
                             (body
                              ((lambda (body) ;; run the tangle-body-hook
                                 (with-temp-buffer
                                   (insert body)
                                   (when (string-match "-r" extra)
                                     (goto-char (point-min))
                                     (while (re-search-forward
                                             (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
                                       (replace-match "")))
                                   (run-hooks 'org-babel-tangle-body-hook)
                                   (buffer-string)))
                               ((lambda (body) ;; expand the body in language specific manner
                                  (if (assoc :no-expand params)
                                      body
                                    (if (fboundp expand-cmd)
                                        (funcall expand-cmd body params)
                                      (org-babel-expand-body:generic
                                       body params
                                       (and (fboundp assignments-cmd)
                                            (funcall assignments-cmd params))))))
                                (if (org-babel-noweb-p params :tangle)
                                    (org-babel-expand-noweb-references info)
                                  (nth 1 info)))))
                             (comment
                              (when (or (string= "both" (cdr (assoc :comments params)))
                                        (string= "org" (cdr (assoc :comments params))))
                                ;; from the previous heading or code-block end
                                (funcall
                                 org-babel-process-comment-text
                                 (buffer-substring
                                  (max (condition-case nil
                                           (save-excursion
                                             (org-back-to-heading t)  ; sets match data
                                             (match-end 0))
                                         (error (point-min)))
                                       (save-excursion
                                         (if (re-search-backward
                                              org-babel-src-block-regexp nil t)
                                             (match-end 0)
                                           (point-min))))
                                  (point)))))
                             by-lang)
                        ;; add the spec for this block to blocks under it's language
                        (setq by-lang (cdr (assoc src-lang blocks)))
                        (setq blocks (delq (assoc src-lang blocks) blocks))
                        (setq blocks (cons
                                      (cons src-lang
                                            (cons (list start-line file link
                                                        source-name params body comment)
                                                  by-lang)) blocks)))))))
    ;; ensure blocks in the correct order
    (setq blocks
          (mapcar
           (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
           blocks))
blocks))

Separative

hey @mike, what version of orgmode did you based upon? I went to ob-tangle where the function is from, and both code and signature are different: signature (defun org-babel-tangle-collect-blocks (&optional language tangle-file) – Ricotta

@Ricotta I'm using 7.9.3f – Separative

Okey dokey, so they might have refactor the whole function for major version 8. I dropped searching a way to achieve it for now since with use-package I have a workaround. Thanks still! :) – Ricotta

So I take it there is no ready-made way to get this same functionality in Org-mode 8.3.2? – Particularism