diff options
author | Eric Schulte <schulte.eric@gmail.com> | 2010-10-19 12:55:36 -0600 |
---|---|---|
committer | Dan Davison <davison@stats.ox.ac.uk> | 2010-10-21 13:06:55 +0100 |
commit | 5bdc0439191a64bd7ea0c410691b925164edbb51 (patch) | |
tree | 5786adf1f3d50e100526bfa6709bf5a17f122572 | |
parent | 4247150094b85b7f380b13a1a7dfd0a2edf70b2d (diff) | |
download | org-mode-5bdc0439191a64bd7ea0c410691b925164edbb51.tar.gz |
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)
-rw-r--r-- | lisp/ob-tangle.el | 106 |
1 files changed, 57 insertions, 49 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index a009390..e53b794 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -282,56 +282,64 @@ code blocks by language." (let* ((start-line (save-restriction (widen) (+ 1 (line-number-at-pos (point))))) (file (buffer-file-name)) - (info (org-babel-get-src-block-info)) - (params (nth 2 info)) - (link (unless (string= (cdr (assoc :tangle params)) "no") - (progn (call-interactively 'org-store-link) - (org-babel-clean-text-properties - (car (pop org-stored-links)))))) - (source-name (intern (or (nth 4 info) - (format "%s:%d" - current-heading block-counter)))) - (src-lang (nth 0 info)) - (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) - (assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang))) - (body ((lambda (body) - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (if (and (cdr (assoc :noweb params)) - (let ((nowebs (split-string - (cdr (assoc :noweb params))))) - (or (member "yes" nowebs) - (member "tangle" nowebs)))) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (comment (when (or (string= "both" (cdr (assoc :comments params))) - (string= "org" (cdr (assoc :comments params)))) - ;; from the previous heading or code-block end - (buffer-substring - (max (condition-case nil - (save-excursion - (org-back-to-heading t) (point)) - (error 0)) - (save-excursion (re-search-backward - org-babel-src-block-regexp nil t) - (match-end 0))) - (point)))) - by-lang) - (unless (string= (cdr (assoc :tangle params)) "no") + (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))) - ;; add the spec for this block to blocks under it's language - (setq by-lang (cdr (assoc src-lang blocks))) - (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks (cons - (cons src-lang - (cons (list start-line file link - source-name params body comment) - by-lang)) blocks)))))) + (let* ((info (org-babel-get-src-block-info 'light)) + (params (nth 2 info)) + (link (unless (string= (cdr (assoc :tangle params)) "no") + (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links)))))) + (source-name + (intern (or (nth 4 info) + (format "%s:%d" + current-heading block-counter)))) + (src-lang (nth 0 info)) + (expand-cmd + (intern (concat "org-babel-expand-body:" src-lang))) + (assignments-cmd + (intern (concat "org-babel-variable-assignments:" src-lang))) + (body + ((lambda (body) + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (and (cdr (assoc :noweb params)) + (let ((nowebs (split-string + (cdr (assoc :noweb params))))) + (or (member "yes" nowebs) + (member "tangle" nowebs)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (comment + (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; from the previous heading or code-block end + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) (point)) + (error 0)) + (save-excursion + (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0))) + (point)))) + by-lang) + ;; add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks (cons + (cons src-lang + (cons (list start-line file link + source-name params body comment) + by-lang)) blocks))))))) ;; ensure blocks in the correct order (setq blocks (mapcar |