mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-05 06:43:00 +00:00
careful not to needlessly execute blocks during tangling
* lisp/ob-tangle.el (org-babel-tangle-collect-blocks): now explicitly checks that a code block will actually be tangled before collecting it's full information (a process which could involve the execution of other code blocks)
This commit is contained in:
parent
4247150094
commit
5bdc043919
|
@ -282,22 +282,30 @@ code blocks by language."
|
||||||
(let* ((start-line (save-restriction (widen)
|
(let* ((start-line (save-restriction (widen)
|
||||||
(+ 1 (line-number-at-pos (point)))))
|
(+ 1 (line-number-at-pos (point)))))
|
||||||
(file (buffer-file-name))
|
(file (buffer-file-name))
|
||||||
(info (org-babel-get-src-block-info))
|
(info (org-babel-get-src-block-info 'light)))
|
||||||
|
(unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
|
||||||
|
(unless (and language (not (string= language src-lang)))
|
||||||
|
(let* ((info (org-babel-get-src-block-info 'light))
|
||||||
(params (nth 2 info))
|
(params (nth 2 info))
|
||||||
(link (unless (string= (cdr (assoc :tangle params)) "no")
|
(link (unless (string= (cdr (assoc :tangle params)) "no")
|
||||||
(progn (call-interactively 'org-store-link)
|
(progn (call-interactively 'org-store-link)
|
||||||
(org-babel-clean-text-properties
|
(org-babel-clean-text-properties
|
||||||
(car (pop org-stored-links))))))
|
(car (pop org-stored-links))))))
|
||||||
(source-name (intern (or (nth 4 info)
|
(source-name
|
||||||
|
(intern (or (nth 4 info)
|
||||||
(format "%s:%d"
|
(format "%s:%d"
|
||||||
current-heading block-counter))))
|
current-heading block-counter))))
|
||||||
(src-lang (nth 0 info))
|
(src-lang (nth 0 info))
|
||||||
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
|
(expand-cmd
|
||||||
(assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang)))
|
(intern (concat "org-babel-expand-body:" src-lang)))
|
||||||
(body ((lambda (body)
|
(assignments-cmd
|
||||||
|
(intern (concat "org-babel-variable-assignments:" src-lang)))
|
||||||
|
(body
|
||||||
|
((lambda (body)
|
||||||
(if (assoc :no-expand params)
|
(if (assoc :no-expand params)
|
||||||
body
|
body
|
||||||
(if (fboundp expand-cmd) (funcall expand-cmd body params)
|
(if (fboundp expand-cmd)
|
||||||
|
(funcall expand-cmd body params)
|
||||||
(org-babel-expand-body:generic
|
(org-babel-expand-body:generic
|
||||||
body params
|
body params
|
||||||
(and (fboundp assignments-cmd)
|
(and (fboundp assignments-cmd)
|
||||||
|
@ -309,7 +317,8 @@ code blocks by language."
|
||||||
(member "tangle" nowebs))))
|
(member "tangle" nowebs))))
|
||||||
(org-babel-expand-noweb-references info)
|
(org-babel-expand-noweb-references info)
|
||||||
(nth 1 info))))
|
(nth 1 info))))
|
||||||
(comment (when (or (string= "both" (cdr (assoc :comments params)))
|
(comment
|
||||||
|
(when (or (string= "both" (cdr (assoc :comments params)))
|
||||||
(string= "org" (cdr (assoc :comments params))))
|
(string= "org" (cdr (assoc :comments params))))
|
||||||
;; from the previous heading or code-block end
|
;; from the previous heading or code-block end
|
||||||
(buffer-substring
|
(buffer-substring
|
||||||
|
@ -317,13 +326,12 @@ code blocks by language."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(org-back-to-heading t) (point))
|
(org-back-to-heading t) (point))
|
||||||
(error 0))
|
(error 0))
|
||||||
(save-excursion (re-search-backward
|
(save-excursion
|
||||||
|
(re-search-backward
|
||||||
org-babel-src-block-regexp nil t)
|
org-babel-src-block-regexp nil t)
|
||||||
(match-end 0)))
|
(match-end 0)))
|
||||||
(point))))
|
(point))))
|
||||||
by-lang)
|
by-lang)
|
||||||
(unless (string= (cdr (assoc :tangle params)) "no")
|
|
||||||
(unless (and language (not (string= language src-lang)))
|
|
||||||
;; add the spec for this block to blocks under it's language
|
;; add the spec for this block to blocks under it's language
|
||||||
(setq by-lang (cdr (assoc src-lang blocks)))
|
(setq by-lang (cdr (assoc src-lang blocks)))
|
||||||
(setq blocks (delq (assoc src-lang blocks) blocks))
|
(setq blocks (delq (assoc src-lang blocks) blocks))
|
||||||
|
@ -331,7 +339,7 @@ code blocks by language."
|
||||||
(cons src-lang
|
(cons src-lang
|
||||||
(cons (list start-line file link
|
(cons (list start-line file link
|
||||||
source-name params body comment)
|
source-name params body comment)
|
||||||
by-lang)) blocks))))))
|
by-lang)) blocks)))))))
|
||||||
;; ensure blocks in the correct order
|
;; ensure blocks in the correct order
|
||||||
(setq blocks
|
(setq blocks
|
||||||
(mapcar
|
(mapcar
|
||||||
|
|
Loading…
Reference in a new issue