Orgmode: how to filter the blocks to be tangle?

泪湿孤枕 提交于 2019-12-05 11:01:53

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

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))
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!