Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Orgmode: how to filter the blocks to be tangle?

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)

like image 918
AdrieanKhisbe Avatar asked May 17 '14 09:05

AdrieanKhisbe


2 Answers

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).

like image 159
itsjeyd Avatar answered Oct 10 '22 08:10

itsjeyd


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))
like image 28
michaelJohn Avatar answered Oct 10 '22 07:10

michaelJohn