ob-tangle.el 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586
  1. ;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research
  5. ;; Homepage: https://orgmode.org
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Extract the code from source blocks out into raw source-code files.
  19. ;;; Code:
  20. (require 'cl-lib)
  21. (require 'org-src)
  22. (require 'org-macs)
  23. (require 'ol)
  24. (declare-function make-directory "files" (dir &optional parents))
  25. (declare-function org-at-heading-p "org" (&optional ignored))
  26. (declare-function org-babel-update-block-body "ob-core" (new-body))
  27. (declare-function org-back-to-heading "org" (&optional invisible-ok))
  28. (declare-function org-before-first-heading-p "org" ())
  29. (declare-function org-element-at-point "org-element" ())
  30. (declare-function org-element-type "org-element" (element))
  31. (declare-function org-heading-components "org" ())
  32. (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
  33. (declare-function outline-previous-heading "outline" ())
  34. (defcustom org-babel-tangle-lang-exts
  35. '(("emacs-lisp" . "el")
  36. ("elisp" . "el"))
  37. "Alist mapping languages to their file extensions.
  38. The key is the language name, the value is the string that should
  39. be inserted as the extension commonly used to identify files
  40. written in this language. If no entry is found in this list,
  41. then the name of the language is used."
  42. :group 'org-babel-tangle
  43. :version "24.1"
  44. :type '(repeat
  45. (cons
  46. (string "Language name")
  47. (string "File Extension"))))
  48. (defcustom org-babel-tangle-use-relative-file-links t
  49. "Use relative path names in links from tangled source back the Org file."
  50. :group 'org-babel-tangle
  51. :type 'boolean)
  52. (defcustom org-babel-post-tangle-hook nil
  53. "Hook run in code files tangled by `org-babel-tangle'."
  54. :group 'org-babel
  55. :version "24.1"
  56. :type 'hook)
  57. (defcustom org-babel-pre-tangle-hook '(save-buffer)
  58. "Hook run at the beginning of `org-babel-tangle'."
  59. :group 'org-babel
  60. :version "24.1"
  61. :type 'hook)
  62. (defcustom org-babel-tangle-body-hook nil
  63. "Hook run over the contents of each code block body."
  64. :group 'org-babel
  65. :version "24.1"
  66. :type 'hook)
  67. (defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
  68. "Format of inserted comments in tangled code files.
  69. The following format strings can be used to insert special
  70. information into the output using `org-fill-template'.
  71. %start-line --- the line number at the start of the code block
  72. %file --------- the file from which the code block was tangled
  73. %link --------- Org style link to the code block
  74. %source-name -- name of the code block
  75. Upon insertion the formatted comment will be commented out, and
  76. followed by a newline. To inhibit this post-insertion processing
  77. set the `org-babel-tangle-uncomment-comments' variable to a
  78. non-nil value.
  79. Whether or not comments are inserted during tangling is
  80. controlled by the :comments header argument."
  81. :group 'org-babel
  82. :version "24.1"
  83. :type 'string)
  84. (defcustom org-babel-tangle-comment-format-end "%source-name ends here"
  85. "Format of inserted comments in tangled code files.
  86. The following format strings can be used to insert special
  87. information into the output using `org-fill-template'.
  88. %start-line --- the line number at the start of the code block
  89. %file --------- the file from which the code block was tangled
  90. %link --------- Org style link to the code block
  91. %source-name -- name of the code block
  92. Upon insertion the formatted comment will be commented out, and
  93. followed by a newline. To inhibit this post-insertion processing
  94. set the `org-babel-tangle-uncomment-comments' variable to a
  95. non-nil value.
  96. Whether or not comments are inserted during tangling is
  97. controlled by the :comments header argument."
  98. :group 'org-babel
  99. :version "24.1"
  100. :type 'string)
  101. (defcustom org-babel-tangle-uncomment-comments nil
  102. "Inhibits automatic commenting and addition of trailing newline
  103. of tangle comments. Use `org-babel-tangle-comment-format-beg'
  104. and `org-babel-tangle-comment-format-end' to customize the format
  105. of tangled comments."
  106. :group 'org-babel
  107. :type 'boolean)
  108. (defcustom org-babel-process-comment-text 'org-remove-indentation
  109. "Function called to process raw Org text collected to be
  110. inserted as comments in tangled source-code files. The function
  111. should take a single string argument and return a string
  112. result. The default value is `org-remove-indentation'."
  113. :group 'org-babel
  114. :version "24.1"
  115. :type 'function)
  116. (defun org-babel-find-file-noselect-refresh (file)
  117. "Find file ensuring that the latest changes on disk are
  118. represented in the file."
  119. (find-file-noselect file 'nowarn)
  120. (with-current-buffer (get-file-buffer file)
  121. (revert-buffer t t t)))
  122. (defmacro org-babel-with-temp-filebuffer (file &rest body)
  123. "Open FILE into a temporary buffer execute BODY there like
  124. `progn', then kill the FILE buffer returning the result of
  125. evaluating BODY."
  126. (declare (indent 1))
  127. (let ((temp-path (make-symbol "temp-path"))
  128. (temp-result (make-symbol "temp-result"))
  129. (temp-file (make-symbol "temp-file"))
  130. (visited-p (make-symbol "visited-p")))
  131. `(let* ((,temp-path ,file)
  132. (,visited-p (get-file-buffer ,temp-path))
  133. ,temp-result ,temp-file)
  134. (org-babel-find-file-noselect-refresh ,temp-path)
  135. (setf ,temp-file (get-file-buffer ,temp-path))
  136. (with-current-buffer ,temp-file
  137. (setf ,temp-result (progn ,@body)))
  138. (unless ,visited-p (kill-buffer ,temp-file))
  139. ,temp-result)))
  140. (def-edebug-spec org-babel-with-temp-filebuffer (form body))
  141. ;;;###autoload
  142. (defun org-babel-tangle-file (file &optional target-file lang)
  143. "Extract the bodies of source code blocks in FILE.
  144. Source code blocks are extracted with `org-babel-tangle'.
  145. Optional argument TARGET-FILE can be used to specify a default
  146. export file for all source blocks. Optional argument LANG can be
  147. used to limit the exported source code blocks by language.
  148. Return a list whose CAR is the tangled file name."
  149. (interactive "fFile to tangle: \nP")
  150. (let ((visited-p (get-file-buffer (expand-file-name file)))
  151. to-be-removed)
  152. (prog1
  153. (save-window-excursion
  154. (find-file file)
  155. (setq to-be-removed (current-buffer))
  156. (mapcar #'expand-file-name (org-babel-tangle nil target-file lang)))
  157. (unless visited-p
  158. (kill-buffer to-be-removed)))))
  159. (defun org-babel-tangle-publish (_ filename pub-dir)
  160. "Tangle FILENAME and place the results in PUB-DIR."
  161. (unless (file-exists-p pub-dir)
  162. (make-directory pub-dir t))
  163. (setq pub-dir (file-name-as-directory pub-dir))
  164. (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
  165. ;;;###autoload
  166. (defun org-babel-tangle (&optional arg target-file lang)
  167. "Write code blocks to source-specific files.
  168. Extract the bodies of all source code blocks from the current
  169. file into their own source-specific files.
  170. With one universal prefix argument, only tangle the block at point.
  171. When two universal prefix arguments, only tangle blocks for the
  172. tangle file of the block at point.
  173. Optional argument TARGET-FILE can be used to specify a default
  174. export file for all source blocks. Optional argument LANG can be
  175. used to limit the exported source code blocks by language."
  176. (interactive "P")
  177. (run-hooks 'org-babel-pre-tangle-hook)
  178. ;; Possibly Restrict the buffer to the current code block
  179. (save-restriction
  180. (save-excursion
  181. (when (equal arg '(4))
  182. (let ((head (org-babel-where-is-src-block-head)))
  183. (if head
  184. (goto-char head)
  185. (user-error "Point is not in a source code block"))))
  186. (let ((block-counter 0)
  187. (org-babel-default-header-args
  188. (if target-file
  189. (org-babel-merge-params org-babel-default-header-args
  190. (list (cons :tangle target-file)))
  191. org-babel-default-header-args))
  192. (tangle-file
  193. (when (equal arg '(16))
  194. (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
  195. (user-error "Point is not in a source code block"))))
  196. path-collector)
  197. (mapc ;; map over all languages
  198. (lambda (by-lang)
  199. (let* ((lang (car by-lang))
  200. (specs (cdr by-lang))
  201. (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
  202. (lang-f (intern
  203. (concat
  204. (or (and (cdr (assoc lang org-src-lang-modes))
  205. (symbol-name
  206. (cdr (assoc lang org-src-lang-modes))))
  207. lang)
  208. "-mode")))
  209. she-banged)
  210. (mapc
  211. (lambda (spec)
  212. (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
  213. (let* ((tangle (funcall get-spec :tangle))
  214. (she-bang (let ((sheb (funcall get-spec :shebang)))
  215. (when (> (length sheb) 0) sheb)))
  216. (tangle-mode (funcall get-spec :tangle-mode))
  217. (base-name (cond
  218. ((string= "yes" tangle)
  219. (file-name-sans-extension
  220. (nth 1 spec)))
  221. ((string= "no" tangle) nil)
  222. ((> (length tangle) 0) tangle)))
  223. (file-name (when base-name
  224. ;; decide if we want to add ext to base-name
  225. (if (and ext (string= "yes" tangle))
  226. (concat base-name "." ext) base-name))))
  227. (when file-name
  228. ;; Possibly create the parent directories for file.
  229. (let ((m (funcall get-spec :mkdirp))
  230. (fnd (file-name-directory file-name)))
  231. (and m fnd (not (string= m "no"))
  232. (make-directory fnd 'parents)))
  233. ;; delete any old versions of file
  234. (and (file-exists-p file-name)
  235. (not (member file-name (mapcar #'car path-collector)))
  236. (delete-file file-name))
  237. ;; drop source-block to file
  238. (with-temp-buffer
  239. (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
  240. (when (and she-bang (not (member file-name she-banged)))
  241. (insert (concat she-bang "\n"))
  242. (setq she-banged (cons file-name she-banged)))
  243. (org-babel-spec-to-string spec)
  244. ;; We avoid append-to-file as it does not work with tramp.
  245. (let ((content (buffer-string)))
  246. (with-temp-buffer
  247. (when (file-exists-p file-name)
  248. (insert-file-contents file-name))
  249. (goto-char (point-max))
  250. ;; Handle :padlines unless first line in file
  251. (unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
  252. (= (point) (point-min)))
  253. (insert "\n"))
  254. (insert content)
  255. (write-region nil nil file-name))))
  256. ;; if files contain she-bangs, then make the executable
  257. (when she-bang
  258. (unless tangle-mode (setq tangle-mode #o755)))
  259. ;; update counter
  260. (setq block-counter (+ 1 block-counter))
  261. (unless (assoc file-name path-collector)
  262. (push (cons file-name tangle-mode) path-collector))))))
  263. specs)))
  264. (if (equal arg '(4))
  265. (org-babel-tangle-single-block 1 t)
  266. (org-babel-tangle-collect-blocks lang tangle-file)))
  267. (message "Tangled %d code block%s from %s" block-counter
  268. (if (= block-counter 1) "" "s")
  269. (file-name-nondirectory
  270. (buffer-file-name
  271. (or (buffer-base-buffer) (current-buffer)))))
  272. ;; run `org-babel-post-tangle-hook' in all tangled files
  273. (when org-babel-post-tangle-hook
  274. (mapc
  275. (lambda (file)
  276. (org-babel-with-temp-filebuffer file
  277. (run-hooks 'org-babel-post-tangle-hook)))
  278. (mapcar #'car path-collector)))
  279. ;; set permissions on tangled files
  280. (mapc (lambda (pair)
  281. (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
  282. path-collector)
  283. (mapcar #'car path-collector)))))
  284. (defun org-babel-tangle-clean ()
  285. "Remove comments inserted by `org-babel-tangle'.
  286. Call this function inside of a source-code file generated by
  287. `org-babel-tangle' to remove all comments inserted automatically
  288. by `org-babel-tangle'. Warning, this comment removes any lines
  289. containing constructs which resemble Org file links or noweb
  290. references."
  291. (interactive)
  292. (goto-char (point-min))
  293. (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
  294. (re-search-forward (org-babel-noweb-wrap) nil t))
  295. (delete-region (save-excursion (beginning-of-line 1) (point))
  296. (save-excursion (end-of-line 1) (forward-char 1) (point)))))
  297. (defun org-babel-spec-to-string (spec)
  298. "Insert SPEC into the current file.
  299. Insert the source-code specified by SPEC into the current source
  300. code file. This function uses `comment-region' which assumes
  301. that the appropriate major-mode is set. SPEC has the form:
  302. (start-line file link source-name params body comment)"
  303. (pcase-let*
  304. ((`(,start ,file ,link ,source ,info ,body ,comment) spec)
  305. (comments (cdr (assq :comments info)))
  306. (link? (or (string= comments "both") (string= comments "link")
  307. (string= comments "yes") (string= comments "noweb")))
  308. (link-data `(("start-line" . ,(number-to-string start))
  309. ("file" . ,file)
  310. ("link" . ,link)
  311. ("source-name" . ,source)))
  312. (insert-comment (lambda (text)
  313. (when (and comments
  314. (not (string= comments "no"))
  315. (org-string-nw-p text))
  316. (if org-babel-tangle-uncomment-comments
  317. ;; Plain comments: no processing.
  318. (insert text)
  319. ;; Ensure comments are made to be
  320. ;; comments, and add a trailing newline.
  321. ;; Also ignore invisible characters when
  322. ;; commenting.
  323. (comment-region
  324. (point)
  325. (progn (insert (org-no-properties text))
  326. (point)))
  327. (end-of-line)
  328. (insert "\n"))))))
  329. (when comment (funcall insert-comment comment))
  330. (when link?
  331. (funcall insert-comment
  332. (org-fill-template
  333. org-babel-tangle-comment-format-beg link-data)))
  334. (insert body "\n")
  335. (when link?
  336. (funcall insert-comment
  337. (org-fill-template
  338. org-babel-tangle-comment-format-end link-data)))))
  339. (defun org-babel-tangle-collect-blocks (&optional language tangle-file)
  340. "Collect source blocks in the current Org file.
  341. Return an association list of source-code block specifications of
  342. the form used by `org-babel-spec-to-string' grouped by language.
  343. Optional argument LANGUAGE can be used to limit the collected
  344. source code blocks by language. Optional argument TANGLE-FILE
  345. can be used to limit the collected code blocks by target file."
  346. (let ((counter 0) last-heading-pos blocks)
  347. (org-babel-map-src-blocks (buffer-file-name)
  348. (let ((current-heading-pos
  349. (org-with-wide-buffer
  350. (org-with-limited-levels (outline-previous-heading)))))
  351. (if (eq last-heading-pos current-heading-pos) (cl-incf counter)
  352. (setq counter 1)
  353. (setq last-heading-pos current-heading-pos)))
  354. (unless (org-in-commented-heading-p)
  355. (let* ((info (org-babel-get-src-block-info 'light))
  356. (src-lang (nth 0 info))
  357. (src-tfile (cdr (assq :tangle (nth 2 info)))))
  358. (unless (or (string= src-tfile "no")
  359. (and tangle-file (not (equal tangle-file src-tfile)))
  360. (and language (not (string= language src-lang))))
  361. ;; Add the spec for this block to blocks under its
  362. ;; language.
  363. (let ((by-lang (assoc src-lang blocks))
  364. (block (org-babel-tangle-single-block counter)))
  365. (if by-lang (setcdr by-lang (cons block (cdr by-lang)))
  366. (push (cons src-lang (list block)) blocks)))))))
  367. ;; Ensure blocks are in the correct order.
  368. (mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
  369. (nreverse blocks))))
  370. (defun org-babel-tangle-single-block (block-counter &optional only-this-block)
  371. "Collect the tangled source for current block.
  372. Return the list of block attributes needed by
  373. `org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is
  374. non-nil, return the full association list to be used by
  375. `org-babel-tangle' directly."
  376. (let* ((info (org-babel-get-src-block-info))
  377. (start-line
  378. (save-restriction (widen)
  379. (+ 1 (line-number-at-pos (point)))))
  380. (file (buffer-file-name (buffer-base-buffer)))
  381. (src-lang (nth 0 info))
  382. (params (nth 2 info))
  383. (extra (nth 3 info))
  384. (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
  385. (match-string 1 extra))
  386. org-coderef-label-format))
  387. (link (let ((l (org-no-properties (org-store-link nil))))
  388. (and (string-match org-link-bracket-re l)
  389. (match-string 1 l))))
  390. (source-name
  391. (or (nth 4 info)
  392. (format "%s:%d"
  393. (or (ignore-errors (nth 4 (org-heading-components)))
  394. "No heading")
  395. block-counter)))
  396. (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
  397. (assignments-cmd
  398. (intern (concat "org-babel-variable-assignments:" src-lang)))
  399. (body
  400. ;; Run the tangle-body-hook.
  401. (let ((body (if (org-babel-noweb-p params :tangle)
  402. (org-babel-expand-noweb-references info)
  403. (nth 1 info))))
  404. (with-temp-buffer
  405. (insert
  406. ;; Expand body in language specific manner.
  407. (cond ((assq :no-expand params) body)
  408. ((fboundp expand-cmd) (funcall expand-cmd body params))
  409. (t
  410. (org-babel-expand-body:generic
  411. body params (and (fboundp assignments-cmd)
  412. (funcall assignments-cmd params))))))
  413. (when (string-match "-r" extra)
  414. (goto-char (point-min))
  415. (while (re-search-forward
  416. (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
  417. (replace-match "")))
  418. (run-hooks 'org-babel-tangle-body-hook)
  419. (buffer-string))))
  420. (comment
  421. (when (or (string= "both" (cdr (assq :comments params)))
  422. (string= "org" (cdr (assq :comments params))))
  423. ;; From the previous heading or code-block end
  424. (funcall
  425. org-babel-process-comment-text
  426. (buffer-substring
  427. (max (condition-case nil
  428. (save-excursion
  429. (org-back-to-heading t) ; Sets match data
  430. (match-end 0))
  431. (error (point-min)))
  432. (save-excursion
  433. (if (re-search-backward
  434. org-babel-src-block-regexp nil t)
  435. (match-end 0)
  436. (point-min))))
  437. (point)))))
  438. (result
  439. (list start-line
  440. (if org-babel-tangle-use-relative-file-links
  441. (file-relative-name file)
  442. file)
  443. (if (and org-babel-tangle-use-relative-file-links
  444. (string-match org-link-types-re link)
  445. (string= (match-string 0 link) "file"))
  446. (concat "file:"
  447. (file-relative-name (match-string 1 link)
  448. (file-name-directory
  449. (cdr (assq :tangle params)))))
  450. link)
  451. source-name
  452. params
  453. (if org-src-preserve-indentation
  454. (org-trim body t)
  455. (org-trim (org-remove-indentation body)))
  456. comment)))
  457. (if only-this-block
  458. (list (cons src-lang (list result)))
  459. result)))
  460. (defun org-babel-tangle-comment-links (&optional info)
  461. "Return a list of begin and end link comments for the code block at point."
  462. (let ((link-data
  463. `(("start-line" . ,(number-to-string
  464. (org-babel-where-is-src-block-head)))
  465. ("file" . ,(buffer-file-name))
  466. ("link" . ,(org-no-properties (org-store-link nil)))
  467. ("source-name" .
  468. ,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
  469. (list (org-fill-template org-babel-tangle-comment-format-beg link-data)
  470. (org-fill-template org-babel-tangle-comment-format-end link-data))))
  471. ;; de-tangling functions
  472. (defun org-babel-detangle (&optional source-code-file)
  473. "Propagate changes in source file back original to Org file.
  474. This requires that code blocks were tangled with link comments
  475. which enable the original code blocks to be found."
  476. (interactive)
  477. (save-excursion
  478. (when source-code-file (find-file source-code-file))
  479. (goto-char (point-min))
  480. (let ((counter 0) new-body end)
  481. (while (re-search-forward org-link-bracket-re nil t)
  482. (when (re-search-forward
  483. (concat " " (regexp-quote (match-string 2)) " ends here"))
  484. (setq end (match-end 0))
  485. (forward-line -1)
  486. (save-excursion
  487. (when (setq new-body (org-babel-tangle-jump-to-org))
  488. (org-babel-update-block-body new-body)))
  489. (setq counter (+ 1 counter)))
  490. (goto-char end))
  491. (prog1 counter (message "Detangled %d code blocks" counter)))))
  492. (defun org-babel-tangle-jump-to-org ()
  493. "Jump from a tangled code file to the related Org mode file."
  494. (interactive)
  495. (let ((mid (point))
  496. start body-start end target-buffer target-char link block-name body)
  497. (save-window-excursion
  498. (save-excursion
  499. (while (and (re-search-backward org-link-bracket-re nil t)
  500. (not ; ever wider searches until matching block comments
  501. (and (setq start (line-beginning-position))
  502. (setq body-start (line-beginning-position 2))
  503. (setq link (match-string 0))
  504. (setq block-name (match-string 2))
  505. (save-excursion
  506. (save-match-data
  507. (re-search-forward
  508. (concat " " (regexp-quote block-name)
  509. " ends here") nil t)
  510. (setq end (line-beginning-position))))))))
  511. (unless (and start (< start mid) (< mid end))
  512. (error "Not in tangled code"))
  513. (setq body (buffer-substring body-start end)))
  514. ;; Go to the beginning of the relative block in Org file.
  515. (org-link-open-from-string link)
  516. (setq target-buffer (current-buffer))
  517. (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
  518. (let ((n (string-to-number (match-string 1 block-name))))
  519. (if (org-before-first-heading-p) (goto-char (point-min))
  520. (org-back-to-heading t))
  521. ;; Do not skip the first block if it begins at point min.
  522. (cond ((or (org-at-heading-p)
  523. (not (eq (org-element-type (org-element-at-point))
  524. 'src-block)))
  525. (org-babel-next-src-block n))
  526. ((= n 1))
  527. (t (org-babel-next-src-block (1- n)))))
  528. (org-babel-goto-named-src-block block-name))
  529. (goto-char (org-babel-where-is-src-block-head))
  530. (forward-line 1)
  531. ;; Try to preserve location of point within the source code in
  532. ;; tangled code file.
  533. (let ((offset (- mid body-start)))
  534. (when (> end (+ offset (point)))
  535. (forward-char offset)))
  536. (setq target-char (point)))
  537. (org-src-switch-to-buffer target-buffer t)
  538. (goto-char target-char)
  539. body))
  540. (provide 'ob-tangle)
  541. ;; Local variables:
  542. ;; generated-autoload-file: "org-loaddefs.el"
  543. ;; End:
  544. ;;; ob-tangle.el ends here