org-babel-tangle.el 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235
  1. ;;; org-babel-tangle.el --- Extract source code from org-mode files
  2. ;; Copyright (C) 2009 Eric Schulte
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research
  5. ;; Homepage: http://orgmode.org
  6. ;; Version: 0.01
  7. ;;; License:
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 3, or (at your option)
  11. ;; any later version.
  12. ;;
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;;
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  20. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21. ;; Boston, MA 02110-1301, USA.
  22. ;;; Commentary:
  23. ;; Extract the code from source blocks out into raw source-code files.
  24. ;;; Code:
  25. (require 'org-babel)
  26. (defvar org-babel-tangle-langs nil
  27. "List of languages supported by `org-babel-tangle'. The first
  28. element of each language's list is a string indicating the name
  29. of the language, the second element should be the file extension
  30. of the language, an optional third element the shebang(#!) line
  31. to use when writing out the language to file, and an optional
  32. fourth element is a flag which when true indicates that the
  33. language does not support comments.")
  34. (defun org-babel-load-file (file)
  35. "Load the contents of the Emacs Lisp source code blocks in the
  36. org-mode formatted FILE. This function will first export the
  37. source code using `org-babel-tangle' and then load the resulting
  38. file using `load-file'."
  39. (flet ((age (file)
  40. (time-to-seconds
  41. (time-subtract (current-time)
  42. (sixth (or (file-attributes (file-truename file))
  43. (file-attributes file)))))))
  44. (let* ((base-name (file-name-sans-extension file))
  45. (exported-file (concat base-name ".el")))
  46. ;; tangle if the org-mode file is newer than the elisp file
  47. (unless (and (file-exists-p exported-file) (> (age file) (age exported-file)))
  48. (org-babel-tangle-file file exported-file "emacs-lisp"))
  49. (load-file exported-file)
  50. (message "loaded %s" exported-file))))
  51. (defun org-babel-tangle-file (file &optional target-file lang)
  52. "Extract the bodies of all source code blocks in FILE with
  53. `org-babel-tangle'. Optional argument TARGET-FILE can be used to
  54. specify a default export file for all source blocks. Optional
  55. argument LANG can be used to limit the exported source code
  56. blocks by language."
  57. (interactive "fFile to tangle: \nP")
  58. (save-window-excursion (find-file file) (org-babel-tangle target-file lang)))
  59. (defun org-babel-tangle-publish (_ filename pub-dir)
  60. "Tangle FILENAME and place the results in PUB-DIR."
  61. (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
  62. (defun org-babel-tangle (&optional target-file lang)
  63. "Extract the bodies of all source code blocks from the current
  64. file into their own source-specific files. Optional argument
  65. TARGET-FILE can be used to specify a default export file for all
  66. source blocks. Optional argument LANG can be used to limit the
  67. exported source code blocks by language."
  68. (interactive)
  69. (save-buffer)
  70. (save-excursion
  71. (let ((block-counter 0)
  72. path-collector)
  73. (mapc ;; map over all languages
  74. (lambda (by-lang)
  75. (let* ((lang (car by-lang))
  76. (specs (cdr by-lang))
  77. (lang-f (intern (concat
  78. (or (and (cdr (assoc lang org-src-lang-modes))
  79. (symbol-name
  80. (cdr (assoc lang org-src-lang-modes))))
  81. lang)
  82. "-mode")))
  83. (lang-specs (cdr (assoc lang org-babel-tangle-langs)))
  84. (ext (first lang-specs))
  85. (she-bang (second lang-specs))
  86. (commentable (and (fboundp lang-f) (not (third lang-specs))))
  87. she-banged)
  88. (mapc
  89. (lambda (spec)
  90. (flet ((get-spec (name)
  91. (cdr (assoc name (third spec)))))
  92. (let* ((tangle (get-spec :tangle))
  93. (she-bang (if (> (length (get-spec :shebang)) 0)
  94. (get-spec :shebang)
  95. she-bang))
  96. (base-name (or (cond
  97. ((string= "yes" tangle)
  98. (file-name-sans-extension (buffer-file-name)))
  99. ((string= "no" tangle) nil)
  100. ((> (length tangle) 0) tangle))
  101. target-file))
  102. (file-name (when base-name
  103. ;; decide if we want to add ext to base-name
  104. (if (and ext (string= "yes" tangle))
  105. (concat base-name "." ext) base-name))))
  106. ;; ;; debugging
  107. ;; (message
  108. ;; "tangle=%S base-name=%S file-name=%S she-bang=%S commentable=%s"
  109. ;; tangle base-name file-name she-bang commentable)
  110. (when file-name
  111. ;; delete any old versions of file
  112. (when (and (file-exists-p file-name)
  113. (not (member file-name path-collector)))
  114. (delete-file file-name))
  115. ;; drop source-block to file
  116. (with-temp-buffer
  117. (if (fboundp lang-f) (funcall lang-f))
  118. (when (and she-bang (not (member file-name she-banged)))
  119. (insert (concat she-bang "\n"))
  120. (setq she-banged (cons file-name she-banged)))
  121. (org-babel-spec-to-string spec)
  122. ;; We avoid append-to-file as it does not work with tramp.
  123. (let ((content (buffer-string)))
  124. (with-temp-buffer
  125. (if (file-exists-p file-name)
  126. (insert-file-contents file-name))
  127. (goto-char (point-max))
  128. (insert content)
  129. (write-region nil nil file-name))))
  130. ;; update counter
  131. (setq block-counter (+ 1 block-counter))
  132. (add-to-list 'path-collector file-name)))))
  133. specs)))
  134. (org-babel-tangle-collect-blocks lang))
  135. (message "tangled %d code block%s" block-counter
  136. (if (= block-counter 1) "" "s"))
  137. path-collector)))
  138. (defun org-babel-tangle-clean ()
  139. "Call this function inside of a source-code file generated by
  140. `org-babel-tangle' to remove all comments inserted automatically
  141. by `org-babel-tangle'. Warning, this comment removes any lines
  142. containing constructs which resemble org-mode file links or noweb
  143. references."
  144. (interactive)
  145. (goto-char (point-min))
  146. (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
  147. (re-search-forward "<<[^[:space:]]*>>" nil t))
  148. (delete-region (save-excursion (move-beginning-of-line 1) (point))
  149. (save-excursion (move-end-of-line 1) (forward-char 1) (point)))))
  150. (defun org-babel-tangle-collect-blocks (&optional lang)
  151. "Collect all source blocks in the current org-mode file.
  152. Return an association list of source-code block specifications of
  153. the form used by `org-babel-spec-to-string' grouped by language.
  154. Optional argument LANG can be used to limit the collected source
  155. code blocks by language."
  156. (let ((block-counter 0) blocks)
  157. (org-babel-map-source-blocks (buffer-file-name)
  158. (setq block-counter (+ 1 block-counter))
  159. (let* ((link (progn (call-interactively 'org-store-link)
  160. (org-babel-clean-text-properties (car (pop org-stored-links)))))
  161. (info (org-babel-get-src-block-info))
  162. (source-name (intern (or (fifth info)
  163. (format "block-%d" block-counter))))
  164. (src-lang (first info))
  165. (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
  166. (params (third info))
  167. by-lang)
  168. (unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
  169. (unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
  170. ;; add the spec for this block to blocks under it's language
  171. (setq by-lang (cdr (assoc src-lang blocks)))
  172. (setq blocks (delq (assoc src-lang blocks) blocks))
  173. (setq blocks
  174. (cons
  175. (cons src-lang
  176. (cons (list link source-name params
  177. ((lambda (body)
  178. (if (assoc :no-expand params)
  179. body
  180. (funcall
  181. (if (fboundp expand-cmd) expand-cmd 'org-babel-expand-body:generic)
  182. body
  183. params)))
  184. (if (and (cdr (assoc :noweb params))
  185. (string= "yes" (cdr (assoc :noweb params))))
  186. (org-babel-expand-noweb-references info) (second info)))
  187. (third (cdr (assoc
  188. src-lang org-babel-tangle-langs))))
  189. by-lang)) blocks))))))
  190. ;; ensure blocks in the correct order
  191. (setq blocks
  192. (mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks))
  193. ;; blocks should contain all source-blocks organized by language
  194. ;; (message "blocks=%S" blocks) ;; debugging
  195. blocks))
  196. (defun org-babel-spec-to-string (spec)
  197. "Insert the source-code specified by SPEC into the current
  198. source code file. This function uses `comment-region' which
  199. assumes that the appropriate major-mode is set. SPEC has the
  200. form
  201. (link source-name params body)"
  202. (flet ((insert-comment (text)
  203. (when commentable
  204. (insert "\n")
  205. (comment-region (point) (progn (insert text) (point)))
  206. (move-end-of-line nil)
  207. (insert "\n"))))
  208. (let ((link (first spec))
  209. (source-name (second spec))
  210. (body (fourth spec))
  211. (commentable (not (if (> (length (cdr (assoc :comments (third spec)))) 0)
  212. (string= (cdr (assoc :comments (third spec))) "no")
  213. (fifth spec)))))
  214. (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
  215. (insert (format "%s" (org-babel-chomp body)))
  216. (insert-comment (format "%s ends here" source-name)))))
  217. (provide 'org-babel-tangle)
  218. ;;; org-babel-tangle.el ends here