summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-06-15 21:38:14 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-06-15 21:38:14 +0200
commit90df55ea7b68ef1ab311d4fc4d8385ea651e39d6 (patch)
treed87a460409104ae832091591dc39f2213e32332b
parentbfe1b2fbe2baa62cd26bf9a76077e56a9c243075 (diff)
downloadorg-mode-90df55ea7b68ef1ab311d4fc4d8385ea651e39d6.tar.gz
ob-tangle: Small refactoring
* lisp/ob-tangle.el (org-babel-tangle-collect-blocks): Refactor.
-rw-r--r--lisp/ob-tangle.el58
1 files changed, 23 insertions, 35 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 1c159a5..12d8092 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -385,47 +385,35 @@ that the appropriate major-mode is set. SPEC has the form:
(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-mode file.
+ "Collect source blocks in the current Org file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANGUAGE can be used to limit the collected
source code blocks by language. Optional argument TANGLE-FILE
can be used to limit the collected code blocks by target file."
- (let ((block-counter 1) (current-heading "") blocks by-lang)
+ (let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
- ((lambda (new-heading)
- (if (not (string= new-heading current-heading))
- (progn
- (setq block-counter 1)
- (setq current-heading new-heading))
- (setq block-counter (+ 1 block-counter))))
- (replace-regexp-in-string "[ \t]" "-"
- (condition-case nil
- (or (nth 4 (org-heading-components))
- "(dummy for heading without text)")
- (error (buffer-file-name)))))
- (let* ((info (org-babel-get-src-block-info 'light))
- (src-lang (nth 0 info))
- (src-tfile (cdr (assoc :tangle (nth 2 info)))))
- (unless (or (org-in-commented-heading-p)
- (string= (cdr (assoc :tangle (nth 2 info))) "no")
- (and tangle-file (not (equal tangle-file src-tfile))))
- (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
- (org-babel-tangle-single-block
- block-counter)
- by-lang)) blocks))))))
- ;; Ensure blocks are in the correct order
- (setq blocks
- (mapcar
- (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
- blocks))
- blocks))
+ (let ((current-heading-pos
+ (org-with-wide-buffer
+ (org-with-limited-levels (outline-previous-heading)))))
+ (cond ((eq last-heading-pos current-heading-pos) (incf counter))
+ ((= counter 1))
+ (t (setq counter 1))))
+ (unless (org-in-commented-heading-p)
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assq :tangle (nth 2 info)))))
+ (unless (or (string= (cdr (assq :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile)))
+ (and language (not (string= language src-lang))))
+ ;; Add the spec for this block to blocks under its
+ ;; language.
+ (let ((by-lang (assoc src-lang blocks))
+ (block (org-babel-tangle-single-block counter)))
+ (if by-lang (setcdr by-lang (cons block (cdr by-lang)))
+ (push (cons src-lang (list block)) blocks)))))))
+ ;; 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)