ob-tangle: Respect buffer local variables

* lisp/ob-tangle.el (org-babel-spec-to-string): Move some processing...
(org-babel-tangle-single-block): ... there.  This function is called
with the Org buffer as its original buffer whereas the previous one is
not.

This is a follow-up to 026fb75, which was reverted.

Reported-by: David Dynerman <emperordali@block-party.net>
<http://permalink.gmane.org/gmane.emacs.orgmode/110670>
This commit is contained in:
Nicolas Goaziou 2016-12-10 00:20:11 +01:00
parent 04799d8e39
commit 7b148e2d0e
1 changed files with 82 additions and 91 deletions

View File

@ -343,63 +343,42 @@ code file. This function uses `comment-region' which assumes
that the appropriate major-mode is set. SPEC has the form:
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
(info (nth 4 spec))
(file (if org-babel-tangle-use-relative-file-links
(file-relative-name (nth 1 spec))
(nth 1 spec)))
(link (let ((link (nth 2 spec)))
(if org-babel-tangle-use-relative-file-links
(when (string-match org-link-types-re link)
(let ((type (match-string 0 link))
(link (substring link (match-end 0))))
(concat
type
(file-relative-name
link
(file-name-directory (cdr (assq :tangle info)))))))
link)))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assq :comments info)))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
(link-data `(("start-line" . ,(number-to-string start-line))
("file" . ,file)
("link" . ,link)
("source-name" . ,source-name)))
(insert-comment (lambda (text)
(when (and comments
(not (string= comments "no"))
(org-string-nw-p text))
(if org-babel-tangle-uncomment-comments
;; Plain comments: no processing.
(insert text)
;; Ensure comments are made to be
;; comments, and add a trailing
;; newline. Also ignore invisible
;; characters when commenting.
(comment-region
(point)
(progn (insert (org-no-properties text))
(point)))
(end-of-line)
(insert "\n"))))))
(pcase-let*
((`(,start ,file ,link ,source ,info ,body ,comment) spec)
(comments (cdr (assq :comments info)))
(link? (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
(link-data `(("start-line" . ,(number-to-string start))
("file" . ,file)
("link" . ,link)
("source-name" . ,source)))
(insert-comment (lambda (text)
(when (and comments
(not (string= comments "no"))
(org-string-nw-p text))
(if org-babel-tangle-uncomment-comments
;; Plain comments: no processing.
(insert text)
;; Ensure comments are made to be
;; comments, and add a trailing newline.
;; Also ignore invisible characters when
;; commenting.
(comment-region
(point)
(progn (insert (org-no-properties text))
(point)))
(end-of-line)
(insert "\n"))))))
(when comment (funcall insert-comment comment))
(when link-p
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(insert
(org-unescape-code-in-string
(if org-src-preserve-indentation (org-trim body t)
(org-trim (org-remove-indentation body))))
"\n")
(when link-p
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
(when link?
(funcall insert-comment
(org-fill-template
org-babel-tangle-comment-format-beg link-data)))
(insert body "\n")
(when link?
(funcall insert-comment
(org-fill-template
org-babel-tangle-comment-format-end link-data)))))
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"Collect source blocks in the current Org file.
@ -432,13 +411,12 @@ can be used to limit the collected code blocks by target file."
;; Ensure blocks are in the correct order.
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
(defun org-babel-tangle-single-block
(block-counter &optional only-this-block)
(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
"Collect the tangled source for current block.
Return the list of block attributes needed by
`org-babel-tangle-collect-blocks'.
When ONLY-THIS-BLOCK is non-nil, return the full association
list to be used by `org-babel-tangle' directly."
`org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is
non-nil, return the full association list to be used by
`org-babel-tangle' directly."
(let* ((info (org-babel-get-src-block-info))
(start-line
(save-restriction (widen)
@ -450,44 +428,39 @@ list to be used by `org-babel-tangle' directly."
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
(match-string 1 extra))
org-coderef-label-format))
(link (let ((link (org-no-properties
(org-store-link nil))))
(and (string-match org-bracket-link-regexp link)
(match-string 1 link))))
(link (let ((l (org-no-properties (org-store-link nil))))
(and (string-match org-bracket-link-regexp l)
(match-string 1 l))))
(source-name
(or (nth 4 info)
(format "%s:%d"
(or (ignore-errors (nth 4 (org-heading-components)))
"No heading")
block-counter)))
(expand-cmd
(intern (concat "org-babel-expand-body:" src-lang)))
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
;; Run the tangle-body-hook.
(let* ((body ;; Expand the body in language specific manner.
(if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(nth 1 info)))
(body
(if (assq :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)))))))
(with-temp-buffer
(insert body)
(when (string-match "-r" extra)
(goto-char (point-min))
(while (re-search-forward
(replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
(replace-match "")))
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string))))
(with-temp-buffer
(insert
;; Expand body in language specific manner.
(let ((body (if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(nth 1 info))))
(cond ((assq :no-expand params) body)
((fboundp expand-cmd) (funcall expand-cmd body params))
(t
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd)
(funcall assignments-cmd params)))))))
(when (string-match "-r" extra)
(goto-char (point-min))
(while (re-search-forward
(replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
(replace-match "")))
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string)))
(comment
(when (or (string= "both" (cdr (assq :comments params)))
(string= "org" (cdr (assq :comments params))))
@ -497,7 +470,7 @@ list to be used by `org-babel-tangle' directly."
(buffer-substring
(max (condition-case nil
(save-excursion
(org-back-to-heading t) ; Sets match data
(org-back-to-heading t) ; Sets match data
(match-end 0))
(error (point-min)))
(save-excursion
@ -507,7 +480,25 @@ list to be used by `org-babel-tangle' directly."
(point-min))))
(point)))))
(result
(list start-line file link source-name params body comment)))
(list start-line
(if org-babel-tangle-use-relative-file-links
(file-relative-name file)
file)
(if (and org-babel-tangle-use-relative-file-links
(string-match org-link-types-re link)
(string= (match-string 0 link) "file"))
(concat "file:"
(file-relative-name (match-string 1 link)
(file-name-directory
(cdr (assq :tangle params)))))
link)
source-name
params
(org-unescape-code-in-string
(if org-src-preserve-indentation
(org-trim body t)
(org-trim (org-remove-indentation body))))
comment)))
(if only-this-block
(list (cons src-lang (list result)))
result)))