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