1 ;;; org-babel-tangle.el --- Extract source code from org-mode files
3 ;; Copyright (C) 2009 Dan Davison, Eric Schulte
5 ;; Author: Dan Davison, Eric Schulte
6 ;; Keywords: literate programming, reproducible research
7 ;; Homepage: http://orgmode.org
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
29 ;; Extract the code from source blocks out into raw source-code files.
34 (defvar org-babel-tangle-langs nil
35 "Association list matching source-block languages. The car of
36 each element should be a string indicating the source block
37 language, and the cdr should be a list containing the extension
38 and shebang(#!) line to use when writing out the language to
41 (defun org-babel-load-file (file)
42 "Load the contents of the Emacs Lisp source code blocks in the
43 org-mode formatted FILE. This function will first export the
44 source code using `org-babel-tangle' and then load the resulting
45 file using `load-file'."
48 (time-subtract (current-time)
49 (sixth (file-attributes file
))))))
50 (let* ((base-name (file-name-sans-extension file
))
51 (exported-file (concat base-name
".el")))
52 ;; tangle if the org-mode file is newer than the elisp file
53 (unless (and (file-exists-p exported-file
) (> (age file
) (age exported-file
)))
54 (org-babel-tangle-file file base-name
"emacs-lisp"))
55 (load-file exported-file
)
56 (message "loaded %s" exported-file
))))
58 (defun org-babel-tangle-file (file &optional target-file lang
)
59 "Extract the bodies of all source code blocks in FILE with
60 `org-babel-tangle'. Optional argument TARGET-FILE can be used to
61 specify a default export file for all source blocks. Optional
62 argument LANG can be used to limit the exported source code
64 (save-window-excursion (find-file file
) (org-babel-tangle target-file lang
)))
66 (defun org-babel-tangle (&optional target-file lang
)
67 "Extract the bodies of all source code blocks from the current
68 file into their own source-specific files. Optional argument
69 TARGET-FILE can be used to specify a default export file for all
70 source blocks. Optional argument LANG can be used to limit the
71 exported source code blocks by language."
74 (let ((block-counter 0)
76 (mapc ;; map over all languages
78 (let* ((lang (car by-lang
))
80 (lang-f (intern (concat lang
"-mode")))
81 (lang-specs (cdr (assoc lang org-babel-tangle-langs
)))
82 (ext (first lang-specs
))
83 (she-bang (second lang-specs
)))
86 (let* ((tangle (cdr (assoc :tangle
(third spec
))))
88 ((string= "yes" tangle
)
89 (file-name-sans-extension (buffer-file-name)))
90 ((string= "no" tangle
) nil
)
91 ((> (length tangle
) 0) tangle
))
93 (file-name (when base-name
94 (concat base-name
"." ext
))))
96 ;; (message "tangle=%S base-name=%S file-name=%S"
97 ;; tangle base-name file-name)
99 ;; delete any old versions of file
100 (when (and (file-exists-p file-name
)
101 (not (member file-name path-collector
)))
102 (delete-file file-name
))
103 ;; drop source-block to file
106 (when she-bang
(insert (concat she-bang
"\n")))
108 (point) (progn (insert "generated by org-babel-tangle") (point)))
109 (org-babel-spec-to-string spec
)
110 (append-to-file nil nil file-name
))
112 (setq block-counter
(+ 1 block-counter
))
113 (add-to-list 'path-collector file-name
))))
115 (org-babel-tangle-collect-blocks lang
))
116 (message "tangled %d source-code block%s" block-counter
117 (if (> block-counter
1) "s" ""))
120 (defun org-babel-tangle-collect-blocks (&optional lang
)
121 "Collect all source blocks in the current org-mode file.
122 Return an association list of source-code block specifications of
123 the form used by `org-babel-spec-to-string' grouped by language.
124 Optional argument LANG can be used to limit the collected source
125 code blocks by language."
126 (let ((block-counter 0) blocks
)
127 (org-babel-map-source-blocks (buffer-file-name)
128 (setq block-counter
(+ 1 block-counter
))
129 (let* ((link (progn (call-interactively 'org-store-link
)
130 (org-babel-clean-text-properties (car (pop org-stored-links
)))))
131 (source-name (intern (or (org-babel-get-src-block-name)
132 (format "block-%d" block-counter
))))
133 (info (org-babel-get-src-block-info))
134 (src-lang (first info
))
135 (body (org-babel-expand-noweb-references info
))
136 (params (third info
))
137 (spec (list link source-name params body
))
139 (unless (string= (cdr (assoc :tangle params
)) "no") ;; maybe skip
140 (unless (and lang
(not (string= lang src-lang
))) ;; maybe limit by language
141 ;; add the spec for this block to blocks under it's language
142 (setq by-lang
(cdr (assoc src-lang blocks
)))
143 (setq blocks
(delq (assoc src-lang blocks
) blocks
))
144 (setq blocks
(cons (cons src-lang
(cons spec by-lang
)) blocks
))))))
145 ;; ensure blocks in the correct order
147 (mapcar (lambda (by-lang) (cons (car by-lang
) (reverse (cdr by-lang
)))) blocks
))
148 ;; blocks should contain all source-blocks organized by language
149 (message "blocks=%S" blocks
) ;; debugging
152 (defun org-babel-spec-to-string (spec)
153 "Insert the source-code specified by SPEC into the current
154 source code file. This function uses `comment-region' which
155 assumes that the appropriate major-mode is set. SPEC has the
158 (link source-name params body)"
159 (flet ((insert-comment (text)
160 (comment-region (point) (progn (insert text
) (point)))))
161 (let ((link (first spec
))
162 (source-name (second spec
))
163 (body (fourth spec
)))
165 (insert-comment (format "[[%s][%s]]" (org-link-escape link
) source-name
))
166 (insert (format "\n%s\n" (org-babel-chomp body
)))
167 (insert-comment (format "%s ends here" source-name
))
170 (defun org-babel-expand-noweb-references (&optional info parent-buffer
)
171 "This function expands Noweb style references in the body of
172 the current source-code block. The reference must be inside of a
173 comment or it will be skipped. For example the following
174 reference would be replaced with the body of the source-code
175 block named 'example-block' (assuming the '#' character starts a
180 This function must be called from inside of the buffer containing
181 the source-code block which holds BODY."
182 (let* ((parent-buffer (or parent-buffer
(current-buffer)))
183 (info (or info
(org-babel-get-src-block-info)))
186 (new-body "") index source-name
)
187 (flet ((nb-add (text)
188 (setq new-body
(concat new-body text
))))
190 (insert body
) (goto-char (point-min))
191 (funcall (intern (concat lang
"-mode")))
193 (while (and (re-search-forward "<<\\(.+\\)>>" nil t
))
194 (save-match-data (setf source-name
(match-string 1)))
195 ;; add interval to new-body
196 (goto-char (match-end 0))
197 (nb-add (buffer-substring index
(point)))
199 ;; if found, add body of referenced source-block
200 (nb-add (save-excursion
201 (set-buffer parent-buffer
)
202 (let ((point (org-babel-find-named-block source-name
)))
206 (concat "\n" (second (org-babel-get-src-block-info))))
208 (nb-add (buffer-substring index
(point-max)))))
211 (provide 'org-babel-tangle
)
212 ;;; org-babel-tangle.el ends here