ob-tangle.el (30470B)
1 ;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 5 ;; Author: Eric Schulte 6 ;; Keywords: literate programming, reproducible research 7 ;; URL: https://orgmode.org 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 <https://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 30 (require 'org-macs) 31 (org-assert-version) 32 33 (require 'cl-lib) 34 (require 'org-src) 35 (require 'org-macs) 36 (require 'ol) 37 38 (declare-function make-directory "files" (dir &optional parents)) 39 (declare-function org-at-heading-p "org" (&optional ignored)) 40 (declare-function org-babel-update-block-body "ob-core" (new-body)) 41 (declare-function org-back-to-heading "org" (&optional invisible-ok)) 42 (declare-function org-before-first-heading-p "org" ()) 43 (declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) 44 (declare-function org-element-property "org-element-ast" (property node)) 45 (declare-function org-element-begin "org-element" (node)) 46 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 47 (declare-function org-element-type-p "org-element-ast" (node types)) 48 (declare-function org-heading-components "org" ()) 49 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) 50 (declare-function org-in-archived-heading-p "org" (&optional no-inheritance)) 51 (declare-function outline-previous-heading "outline" ()) 52 (defvar org-id-link-to-org-use-id) ; Dynamically scoped 53 54 (defgroup org-babel-tangle nil 55 "Options for extracting source code from code blocks." 56 :tag "Org Babel Tangle" 57 :group 'org-babel) 58 59 (defcustom org-babel-tangle-lang-exts 60 '(("emacs-lisp" . "el") 61 ("elisp" . "el")) 62 "Alist mapping languages to their file extensions. 63 The key is the language name, the value is the string that should 64 be inserted as the extension commonly used to identify files 65 written in this language. If no entry is found in this list, 66 then the name of the language is used." 67 :group 'org-babel-tangle 68 :version "24.1" 69 :type '(repeat 70 (cons 71 (string "Language name") 72 (string "File Extension")))) 73 74 (defcustom org-babel-tangle-use-relative-file-links t 75 "Use relative path names in links from tangled source back the Org file." 76 :group 'org-babel-tangle 77 :type 'boolean) 78 79 (defcustom org-babel-post-tangle-hook nil 80 "Hook run in code files tangled by `org-babel-tangle'." 81 :group 'org-babel-tangle 82 :version "24.1" 83 :type 'hook) 84 85 (defcustom org-babel-pre-tangle-hook '(save-buffer) 86 "Hook run at the beginning of `org-babel-tangle' in the original buffer." 87 :group 'org-babel-tangle 88 :version "24.1" 89 :type 'hook) 90 91 (defcustom org-babel-tangle-body-hook nil 92 "Hook run over the contents of each code block body." 93 :group 'org-babel-tangle 94 :version "24.1" 95 :type 'hook) 96 97 (defcustom org-babel-tangle-finished-hook nil 98 "Hook run at the very end of `org-babel-tangle' in the original buffer. 99 In this way, it is the counterpart to `org-babel-pre-tangle-hook'." 100 :group 'org-babel-tangle 101 :package-version '(Org . "9.6") 102 :type 'hook) 103 104 (defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" 105 "Format of inserted comments in tangled code files. 106 The following format strings can be used to insert special 107 information into the output using `org-fill-template'. 108 %start-line --- the line number at the start of the code block 109 %file --------- the file from which the code block was tangled 110 %link --------- Org style link to the code block 111 %source-name -- name of the code block 112 113 Upon insertion the formatted comment will be commented out, and 114 followed by a newline. To inhibit this post-insertion processing 115 set the `org-babel-tangle-uncomment-comments' variable to a 116 non-nil value. 117 118 Whether or not comments are inserted during tangling is 119 controlled by the :comments header argument." 120 :group 'org-babel-tangle 121 :version "24.1" 122 :type 'string) 123 124 (defcustom org-babel-tangle-comment-format-end "%source-name ends here" 125 "Format of inserted comments in tangled code files. 126 The following format strings can be used to insert special 127 information into the output using `org-fill-template'. 128 %start-line --- the line number at the start of the code block 129 %file --------- the file from which the code block was tangled 130 %link --------- Org style link to the code block 131 %source-name -- name of the code block 132 133 Upon insertion the formatted comment will be commented out, and 134 followed by a newline. To inhibit this post-insertion processing 135 set the `org-babel-tangle-uncomment-comments' variable to a 136 non-nil value. 137 138 Whether or not comments are inserted during tangling is 139 controlled by the :comments header argument." 140 :group 'org-babel-tangle 141 :version "24.1" 142 :type 'string) 143 144 (defcustom org-babel-tangle-uncomment-comments nil 145 "Inhibits automatic commenting and addition of trailing newline 146 of tangle comments. Use `org-babel-tangle-comment-format-beg' 147 and `org-babel-tangle-comment-format-end' to customize the format 148 of tangled comments." 149 :group 'org-babel-tangle 150 :type 'boolean) 151 152 (defcustom org-babel-process-comment-text 'org-remove-indentation 153 "Function called to process raw Org text collected to be 154 inserted as comments in tangled source-code files. The function 155 should take a single string argument and return a string 156 result. The default value is `org-remove-indentation'." 157 :group 'org-babel-tangle 158 :version "24.1" 159 :type 'function) 160 161 (defcustom org-babel-tangle-default-file-mode #o644 162 "The default mode used for tangled files, as an integer. 163 The default value 420 correspands to the octal #o644, which is 164 read-write permissions for the user, read-only for everyone else." 165 :group 'org-babel-tangle 166 :package-version '(Org . "9.6") 167 :type 'integer) 168 169 (defcustom org-babel-tangle-remove-file-before-write 'auto 170 "How to overwrite the existing tangle target. 171 When set to nil, `org-babel-tangle' will replace contents of an existing 172 tangle target (and fail when tangle target is read-only). 173 When set to t, the tangle target (including read-only) will be deleted 174 first and a new file, possibly with different ownership and 175 permissions, will be created. 176 When set to symbol `auto', overwrite read-only tangle targets and 177 replace contents otherwise." 178 :group 'org-babel-tangle 179 :package-version '(Org . "9.7") 180 :type '(choice 181 (const :tag "Replace contents, but keep the same file" nil) 182 (const :tag "Re-create file" t) 183 (const :tag "Re-create when read-only" auto)) 184 :safe t) 185 186 (defun org-babel-find-file-noselect-refresh (file) 187 "Find file ensuring that the latest changes on disk are represented in the file." 188 (find-file-noselect file 'nowarn) 189 (with-current-buffer (get-file-buffer file) 190 (revert-buffer t t t))) 191 192 (defmacro org-babel-with-temp-filebuffer (file &rest body) 193 "Open FILE into a temporary buffer execute BODY there like 194 `progn', then kill the FILE buffer returning the result of 195 evaluating BODY." 196 (declare (indent 1) (debug t)) 197 (let ((temp-path (make-symbol "temp-path")) 198 (temp-result (make-symbol "temp-result")) 199 (temp-file (make-symbol "temp-file")) 200 (visited-p (make-symbol "visited-p"))) 201 `(let* ((,temp-path ,file) 202 (,visited-p (get-file-buffer ,temp-path)) 203 ,temp-result ,temp-file) 204 (org-babel-find-file-noselect-refresh ,temp-path) 205 (setf ,temp-file (get-file-buffer ,temp-path)) 206 (with-current-buffer ,temp-file 207 (setf ,temp-result (progn ,@body))) 208 (unless ,visited-p (kill-buffer ,temp-file)) 209 ,temp-result))) 210 211 ;;;###autoload 212 (defun org-babel-tangle-file (file &optional target-file lang-re) 213 "Extract the bodies of source code blocks in FILE. 214 Source code blocks are extracted with `org-babel-tangle'. 215 216 Optional argument TARGET-FILE can be used to specify a default 217 export file for all source blocks. 218 219 Optional argument LANG-RE can be used to limit the exported 220 source code blocks by languages matching a regular expression. 221 222 Return list of the tangled file names." 223 (interactive "fFile to tangle: \nP") 224 (org-with-file-buffer file 225 (org-with-wide-buffer 226 (mapcar #'expand-file-name 227 (org-babel-tangle nil target-file lang-re))))) 228 229 (defun org-babel-tangle-publish (_ filename pub-dir) 230 "Tangle FILENAME and place the results in PUB-DIR." 231 (unless (file-exists-p pub-dir) 232 (make-directory pub-dir t)) 233 (setq pub-dir (file-name-as-directory pub-dir)) 234 ;; Rename files to avoid copying to same file when publishing to ./ 235 ;; `copy-file' would throw an error when copying file to self. 236 (mapc (lambda (el) (rename-file el pub-dir t)) 237 (org-babel-tangle-file filename))) 238 239 ;;;###autoload 240 (defun org-babel-tangle (&optional arg target-file lang-re) 241 "Write code blocks to source-specific files. 242 Extract the bodies of all source code blocks from the current 243 file into their own source-specific files. Return the list of files. 244 With one universal prefix argument, only tangle the block at point. 245 When two universal prefix arguments, only tangle blocks for the 246 tangle file of the block at point. 247 Optional argument TARGET-FILE can be used to specify a default 248 export file for all source blocks. Optional argument LANG-RE can 249 be used to limit the exported source code blocks by languages 250 matching a regular expression." 251 (interactive "P") 252 (run-hooks 'org-babel-pre-tangle-hook) 253 ;; Possibly Restrict the buffer to the current code block 254 (save-restriction 255 (save-excursion 256 (when (equal arg '(4)) 257 (let ((head (org-babel-where-is-src-block-head))) 258 (if head 259 (goto-char head) 260 (user-error "Point is not in a source code block")))) 261 (let ((block-counter 0) 262 (org-babel-default-header-args 263 (if target-file 264 (org-babel-merge-params org-babel-default-header-args 265 (list (cons :tangle target-file))) 266 org-babel-default-header-args)) 267 (tangle-file 268 (when (equal arg '(16)) 269 (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval)))) 270 (user-error "Point is not in a source code block")))) 271 path-collector 272 (source-file buffer-file-name)) 273 (mapc ;; map over file-names 274 (lambda (by-fn) 275 (let ((file-name (car by-fn))) 276 (when file-name 277 (let ((lspecs (cdr by-fn)) 278 (fnd (file-name-directory file-name)) 279 modes make-dir she-banged lang) 280 ;; drop source-blocks to file 281 ;; We avoid append-to-file as it does not work with tramp. 282 (with-temp-buffer 283 (mapc 284 (lambda (lspec) 285 (let* ((block-lang (car lspec)) 286 (spec (cdr lspec)) 287 (get-spec (lambda (name) (cdr (assq name (nth 4 spec))))) 288 (she-bang (let ((sheb (funcall get-spec :shebang))) 289 (when (> (length sheb) 0) sheb))) 290 (tangle-mode (funcall get-spec :tangle-mode))) 291 (unless (string-equal block-lang lang) 292 (setq lang block-lang) 293 (let ((lang-f (org-src-get-lang-mode lang))) 294 (when (fboundp lang-f) (ignore-errors (funcall lang-f))))) 295 ;; if file contains she-bangs, then make it executable 296 (when she-bang 297 (unless tangle-mode (setq tangle-mode #o755))) 298 (when tangle-mode 299 (add-to-list 'modes (org-babel-interpret-file-mode tangle-mode))) 300 ;; Possibly create the parent directories for file. 301 (let ((m (funcall get-spec :mkdirp))) 302 (and m fnd (not (string= m "no")) 303 (setq make-dir t))) 304 ;; Handle :padlines unless first line in file 305 (unless (or (string= "no" (funcall get-spec :padline)) 306 (= (point) (point-min))) 307 (insert "\n")) 308 (when (and she-bang (not she-banged)) 309 (insert (concat she-bang "\n")) 310 (setq she-banged t)) 311 (org-babel-spec-to-string spec) 312 (setq block-counter (+ 1 block-counter)))) 313 lspecs) 314 (when make-dir 315 (make-directory fnd 'parents)) 316 (unless 317 (and (file-exists-p file-name) 318 (let ((tangle-buf (current-buffer))) 319 (with-temp-buffer 320 (insert-file-contents file-name) 321 (and 322 (equal (buffer-size) 323 (buffer-size tangle-buf)) 324 (= 0 325 (let (case-fold-search) 326 (compare-buffer-substrings 327 nil nil nil 328 tangle-buf nil nil))))))) 329 (when (equal (if (file-name-absolute-p file-name) 330 file-name 331 (expand-file-name file-name)) 332 (if (file-name-absolute-p source-file) 333 source-file 334 (expand-file-name source-file))) 335 (error "Not allowed to tangle into the same file as self")) 336 ;; We do not erase, but overwrite previous file 337 ;; to preserve any existing symlinks. 338 ;; This behavior is modified using 339 ;; `org-babel-tangle-remove-file-before-write' to 340 ;; tangle to read-only files. 341 (when (and 342 (file-exists-p file-name) 343 (pcase org-babel-tangle-remove-file-before-write 344 (`auto (not (file-writable-p file-name))) 345 (`t t) 346 (`nil nil) 347 (_ (error "Invalid value of `org-babel-tangle-remove-file-before-write': %S" 348 org-babel-tangle-remove-file-before-write)))) 349 (delete-file file-name)) 350 (write-region nil nil file-name) 351 (mapc (lambda (mode) (set-file-modes file-name mode)) modes)) 352 (push file-name path-collector)))))) 353 (if (equal arg '(4)) 354 (org-babel-tangle-single-block 1 t) 355 (org-babel-tangle-collect-blocks lang-re tangle-file))) 356 (message "Tangled %d code block%s from %s" block-counter 357 (if (= block-counter 1) "" "s") 358 (file-name-nondirectory 359 (buffer-file-name 360 (or (buffer-base-buffer) 361 (current-buffer) 362 (and (org-src-edit-buffer-p) 363 (org-src-source-buffer)))))) 364 ;; run `org-babel-post-tangle-hook' in all tangled files 365 (when org-babel-post-tangle-hook 366 (mapc 367 (lambda (file) 368 (org-babel-with-temp-filebuffer file 369 (run-hooks 'org-babel-post-tangle-hook))) 370 path-collector)) 371 (run-hooks 'org-babel-tangle-finished-hook) 372 path-collector)))) 373 374 (defun org-babel-interpret-file-mode (mode) 375 "Determine the integer representation of a file MODE specification. 376 The following forms are currently recognized: 377 - an integer (returned without modification) 378 - \"o755\" (chmod style octal) 379 - \"rwxrw-r--\" (ls style specification) 380 - \"a=rw,u+x\" (chmod style) * 381 382 * The interpretation of these forms relies on `file-modes-symbolic-to-number', 383 and uses `org-babel-tangle-default-file-mode' as the base mode." 384 (cond 385 ((integerp mode) 386 (if (string-match-p "^[0-7][0-7][0-7]$" (format "%o" mode)) 387 mode 388 (user-error "%1$o is not a valid file mode octal. \ 389 Did you give the decimal value %1$d by mistake?" mode))) 390 ((not (stringp mode)) 391 (error "File mode %S not recognized as a valid format" mode)) 392 ((string-match-p "^o0?[0-7][0-7][0-7]$" mode) 393 (string-to-number (replace-regexp-in-string "^o" "" mode) 8)) 394 ((string-match-p "^[ugoa]*\\(?:[+=-][rwxXstugo]*\\)+\\(,[ugoa]*\\(?:[+=-][rwxXstugo]*\\)+\\)*$" mode) 395 ;; Match regexp taken from `file-modes-symbolic-to-number'. 396 (file-modes-symbolic-to-number mode org-babel-tangle-default-file-mode)) 397 ((string-match-p "^[r-][w-][xs-][r-][w-][xs-][r-][w-][x-]$" mode) 398 (file-modes-symbolic-to-number (concat "u=" (delete ?- (substring mode 0 3)) 399 ",g=" (delete ?- (substring mode 3 6)) 400 ",o=" (delete ?- (substring mode 6 9))) 401 0)) 402 (t (error "File mode %S not recognized as a valid format. See `org-babel-interpret-file-mode'" mode)))) 403 404 (defun org-babel-tangle-clean () 405 "Remove comments inserted by `org-babel-tangle'. 406 Call this function inside of a source-code file generated by 407 `org-babel-tangle' to remove all comments inserted automatically 408 by `org-babel-tangle'. Warning, this comment removes any lines 409 containing constructs which resemble Org file links or noweb 410 references." 411 (interactive) 412 (goto-char (point-min)) 413 (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) 414 (re-search-forward (org-babel-noweb-wrap) nil t)) 415 (delete-region (save-excursion (forward-line) (point)) 416 (save-excursion (end-of-line 1) (forward-char 1) (point))))) 417 418 (defun org-babel-spec-to-string (spec) 419 "Insert SPEC into the current file. 420 421 Insert the source-code specified by SPEC into the current source 422 code file. This function uses `comment-region' which assumes 423 that the appropriate major-mode is set. SPEC has the form: 424 425 (start-line file link source-name params body comment)" 426 (pcase-let* 427 ((`(,start ,file ,link ,source ,info ,body ,comment) spec) 428 (comments (cdr (assq :comments info))) 429 (link? (or (string= comments "both") (string= comments "link") 430 (string= comments "yes") (string= comments "noweb"))) 431 (link-data `(("start-line" . ,(number-to-string start)) 432 ("file" . ,file) 433 ("link" . ,link) 434 ("source-name" . ,source))) 435 (insert-comment (lambda (text) 436 (when (and comments 437 (not (string= comments "no")) 438 (org-string-nw-p text)) 439 (if org-babel-tangle-uncomment-comments 440 ;; Plain comments: no processing. 441 (insert text) 442 ;; Ensure comments are made to be 443 ;; comments, and add a trailing newline. 444 ;; Also ignore invisible characters when 445 ;; commenting. 446 (comment-region 447 (point) 448 (progn (insert (org-no-properties text)) 449 (point))) 450 (end-of-line) 451 (insert "\n")))))) 452 (when comment (funcall insert-comment comment)) 453 (when link? 454 (funcall insert-comment 455 (org-fill-template 456 org-babel-tangle-comment-format-beg link-data))) 457 (insert body "\n") 458 (when link? 459 (funcall insert-comment 460 (org-fill-template 461 org-babel-tangle-comment-format-end link-data))))) 462 463 (defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile) 464 "Return effective tangled absolute filename of a source-code block. 465 BUFFER-FN is the absolute file name of the buffer, SRC-LANG the 466 language of the block and SRC-TFILE is the value of the :tangle 467 header argument, as computed by `org-babel-tangle-single-block'." 468 (let* ((fnd (file-name-directory buffer-fn)) 469 (base-name (cond 470 ((string= "yes" src-tfile) 471 ;; Use the buffer name 472 (file-name-sans-extension buffer-fn)) 473 ((string= "no" src-tfile) nil) 474 ((> (length src-tfile) 0) 475 (expand-file-name src-tfile fnd)))) 476 (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) 477 (when base-name 478 ;; decide if we want to add ext to base-name 479 (if (and ext (string= "yes" src-tfile)) 480 (concat base-name "." ext) base-name)))) 481 482 (defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file) 483 "Collect source blocks in the current Org file. 484 Return an association list of language and source-code block 485 specifications of the form used by `org-babel-spec-to-string' 486 grouped by tangled file name. 487 488 Optional argument LANG-RE can be used to limit the collected 489 source code blocks by languages matching a regular expression. 490 491 Optional argument TANGLE-FILE can be used to limit the collected 492 code blocks by target file." 493 (let ((counter 0) 494 (buffer-fn (buffer-file-name (buffer-base-buffer))) 495 last-heading-pos blocks) 496 (org-babel-map-src-blocks (buffer-file-name) 497 (let ((current-heading-pos 498 (or (org-element-begin 499 (org-element-lineage 500 (org-element-at-point) 501 'headline t)) 502 1))) 503 (if (eq last-heading-pos current-heading-pos) (cl-incf counter) 504 (setq counter 1) 505 (setq last-heading-pos current-heading-pos))) 506 (unless (or (org-in-commented-heading-p) 507 (org-in-archived-heading-p)) 508 (let* ((info (org-babel-get-src-block-info 'no-eval)) 509 (src-lang (nth 0 info)) 510 (src-tfile (cdr (assq :tangle (nth 2 info))))) 511 (unless (or (string= src-tfile "no") 512 (not src-lang) ;; src block without lang 513 (and tangle-file (not (equal tangle-file src-tfile))) 514 (and lang-re (not (string-match-p lang-re src-lang)))) 515 ;; Add the spec for this block to blocks under its tangled 516 ;; file name. 517 (let* ((block (org-babel-tangle-single-block counter)) 518 (src-tfile (cdr (assq :tangle (nth 4 block)))) 519 (file-name (org-babel-effective-tangled-filename 520 buffer-fn src-lang src-tfile)) 521 (by-fn (assoc file-name blocks))) 522 (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) 523 (push (cons file-name (list (cons src-lang block))) blocks))))))) 524 ;; Ensure blocks are in the correct order. 525 (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) 526 (nreverse blocks)))) 527 528 (defun org-babel-tangle--unbracketed-link (params) 529 "Get a raw link to the src block at point, without brackets. 530 531 The PARAMS are the 3rd element of the info for the same src block." 532 (unless (string= "no" (cdr (assq :comments params))) 533 (save-match-data 534 (let* ((l (org-no-properties 535 (cl-letf (((symbol-function 'org-store-link-functions) 536 (lambda () nil))) 537 (org-store-link nil)))) 538 (bare (and l 539 (string-match org-link-bracket-re l) 540 (match-string 1 l)))) 541 (when bare 542 (if (and org-babel-tangle-use-relative-file-links 543 (string-match org-link-types-re bare) 544 (string= (match-string 1 bare) "file")) 545 (concat "file:" 546 (file-relative-name (substring bare (match-end 0)) 547 (file-name-directory 548 (cdr (assq :tangle params))))) 549 bare)))))) 550 551 (defvar org-outline-regexp) ; defined in lisp/org.el 552 (defun org-babel-tangle-single-block (block-counter &optional only-this-block) 553 "Collect the tangled source for current block. 554 Return the list of block attributes needed by 555 `org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is 556 non-nil, return the full association list to be used by 557 `org-babel-tangle' directly." 558 (let* ((info (org-babel-get-src-block-info)) 559 (start-line 560 (save-restriction (widen) 561 (+ 1 (line-number-at-pos (point))))) 562 (file (buffer-file-name (buffer-base-buffer))) 563 (src-lang (nth 0 info)) 564 (params (nth 2 info)) 565 (extra (nth 3 info)) 566 (coderef (nth 6 info)) 567 (cref-regexp (org-src-coderef-regexp coderef)) 568 (link (org-babel-tangle--unbracketed-link params)) 569 (source-name 570 (or (nth 4 info) 571 (format "%s:%d" 572 (or (ignore-errors (nth 4 (org-heading-components))) 573 "No heading") 574 block-counter))) 575 (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) 576 (assignments-cmd 577 (intern (concat "org-babel-variable-assignments:" src-lang))) 578 (body 579 ;; Run the tangle-body-hook. 580 (let ((body (if (org-babel-noweb-p params :tangle) 581 (if (string= "strip-tangle" (cdr (assq :noweb (nth 2 info)))) 582 (replace-regexp-in-string (org-babel-noweb-wrap) "" (nth 1 info)) 583 (org-babel-expand-noweb-references info)) 584 (nth 1 info)))) 585 (with-temp-buffer 586 (insert 587 ;; Expand body in language specific manner. 588 (cond ((assq :no-expand params) body) 589 ((fboundp expand-cmd) (funcall expand-cmd body params)) 590 (t 591 (org-babel-expand-body:generic 592 body params (and (fboundp assignments-cmd) 593 (funcall assignments-cmd params)))))) 594 (when (string-match "-r" extra) 595 (goto-char (point-min)) 596 (while (re-search-forward cref-regexp nil t) 597 (replace-match ""))) 598 (run-hooks 'org-babel-tangle-body-hook) 599 (buffer-string)))) 600 (comment 601 (when (or (string= "both" (cdr (assq :comments params))) 602 (string= "org" (cdr (assq :comments params)))) 603 ;; From the previous heading or code-block end 604 (funcall 605 org-babel-process-comment-text 606 (buffer-substring 607 (max (condition-case nil 608 (save-excursion 609 (org-back-to-heading t) 610 (re-search-forward org-outline-regexp)) 611 (error (point-min))) 612 (save-excursion 613 (if (re-search-backward 614 org-babel-src-block-regexp nil t) 615 (match-end 0) 616 (point-min)))) 617 (point))))) 618 (src-tfile (cdr (assq :tangle params))) 619 (result 620 (list start-line 621 (if org-babel-tangle-use-relative-file-links 622 (file-relative-name file) 623 file) 624 link 625 source-name 626 params 627 (if (org-src-preserve-indentation-p) (org-trim body t) 628 (org-trim (org-remove-indentation body))) 629 comment))) 630 (if only-this-block 631 (let* ((file-name (org-babel-effective-tangled-filename 632 file src-lang src-tfile))) 633 (list (cons file-name (list (cons src-lang result))))) 634 result))) 635 636 (defun org-babel-tangle-comment-links (&optional info) 637 "Return a list of begin and end link comments for the code block at point. 638 INFO, when non nil, is the source block information, as returned 639 by `org-babel-get-src-block-info'." 640 (let ((link-data (pcase (or info (org-babel-get-src-block-info 'no-eval)) 641 (`(,_ ,_ ,params ,_ ,name ,start ,_) 642 `(("start-line" . ,(org-with-point-at start 643 (number-to-string 644 (line-number-at-pos)))) 645 ("file" . ,(buffer-file-name)) 646 ("link" . ,(org-babel-tangle--unbracketed-link params)) 647 ("source-name" . ,name)))))) 648 (list (org-fill-template org-babel-tangle-comment-format-beg link-data) 649 (org-fill-template org-babel-tangle-comment-format-end link-data)))) 650 651 ;; de-tangling functions 652 (defun org-babel-detangle (&optional source-code-file) 653 "Propagate changes from current source buffer back to the original Org file. 654 This requires that code blocks were tangled with link comments 655 which enable the original code blocks to be found. 656 657 Optional argument SOURCE-CODE-FILE is the file path to be used instead 658 of the current buffer." 659 (interactive) 660 (save-excursion 661 (when source-code-file (find-file source-code-file)) 662 (goto-char (point-min)) 663 (let ((counter 0) new-body end) 664 (while (re-search-forward org-link-bracket-re nil t) 665 (if (and (match-string 2) 666 (re-search-forward 667 (concat " " (regexp-quote (match-string 2)) " ends here") nil t)) 668 (progn (setq end (match-end 0)) 669 (forward-line -1) 670 (save-excursion 671 (when (setq new-body (org-babel-tangle-jump-to-org)) 672 (org-babel-update-block-body new-body))) 673 (setq counter (+ 1 counter))) 674 (setq end (point))) 675 (goto-char end)) 676 (prog1 counter (message "Detangled %d code blocks" counter))))) 677 678 (defun org-babel-tangle-jump-to-org () 679 "Jump from a tangled code file to the related Org mode file." 680 (interactive) 681 (let ((mid (point)) 682 start body-start end target-buffer target-char link block-name body) 683 (save-window-excursion 684 (save-excursion 685 (while (and (re-search-backward org-link-bracket-re nil t) 686 (not ; ever wider searches until matching block comments 687 (and (setq start (line-beginning-position)) 688 (setq body-start (line-beginning-position 2)) 689 (setq link (match-string 0)) 690 (setq block-name (match-string 2)) 691 (save-excursion 692 (save-match-data 693 (re-search-forward 694 (concat " " (regexp-quote block-name) 695 " ends here") 696 nil t) 697 (setq end (line-beginning-position)))))))) 698 (unless (and start (< start mid) (< mid end)) 699 (error "Not in tangled code")) 700 (setq body (buffer-substring body-start end))) 701 ;; Go to the beginning of the relative block in Org file. 702 ;; Explicitly allow fuzzy search even if user customized 703 ;; otherwise. 704 (let (org-link-search-must-match-exact-headline) 705 (org-link-open-from-string link)) 706 (setq target-buffer (current-buffer)) 707 (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) 708 (let ((n (string-to-number (match-string 1 block-name)))) 709 (if (org-before-first-heading-p) (goto-char (point-min)) 710 (org-back-to-heading t)) 711 ;; Do not skip the first block if it begins at point min. 712 (cond ((or (org-at-heading-p) 713 (not (org-element-type-p (org-element-at-point) 'src-block))) 714 (org-babel-next-src-block n)) 715 ((= n 1)) 716 (t (org-babel-next-src-block (1- n))))) 717 (org-babel-goto-named-src-block block-name)) 718 (goto-char (org-babel-where-is-src-block-head)) 719 (forward-line 1) 720 ;; Try to preserve location of point within the source code in 721 ;; tangled code file. 722 (let ((offset (- mid body-start))) 723 (when (> end (+ offset (point))) 724 (forward-char offset))) 725 (setq target-char (point))) 726 (org-src-switch-to-buffer target-buffer t) 727 (goto-char target-char) 728 body)) 729 730 (provide 'ob-tangle) 731 732 ;; Local variables: 733 ;; generated-autoload-file: "org-loaddefs.el" 734 ;; End: 735 736 ;;; ob-tangle.el ends here