summaryrefslogtreecommitdiff
path: root/lisp/ob-tangle.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-12-18 18:15:46 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-12-18 18:33:07 +0100
commitc5d8495eb3e0cd02bce787b2126207057edb3e61 (patch)
treeb722ae24e016d6fed6a667b18db2cbbf15e062ce /lisp/ob-tangle.el
parent2cc0aeaf303018977e09a4cf565bb76fbfdf7817 (diff)
Imported Upstream version 9.0.2
Diffstat (limited to 'lisp/ob-tangle.el')
-rw-r--r--lisp/ob-tangle.el173
1 files changed, 82 insertions, 91 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 5e1b953..a5e18a8 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -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))))
+ (let ((body (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (with-temp-buffer
+ (insert
+ ;; Expand body in language specific manner.
+ (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)))