mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-05 06:43:00 +00:00
Code Releases Activity

careful not to needlessly execute blocks during tangling

Browse source 
* 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:
Eric Schulte 2010-10-19 12:55:36 -06:00 committed by Dan Davison
parent 4247150094
commit 5bdc043919
1 changed files with 57 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp/ob-tangle.el
View file

@ -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