* (no subject)
@ 2013-01-15 19:26 Rick Frankel
2013-01-15 20:28 ` [PATCH] ob-tangle: Correctly process tangling of single source block Rick Frankel
0 siblings, 1 reply; 3+ messages in thread
From: Rick Frankel @ 2013-01-15 19:26 UTC (permalink / raw)
To: emacs-orgmode
From 8aca214f0aefe3d89162115b9d241766ae62c5c1 Mon Sep 17 00:00:00 2001
From: Rick Frankel <org@rickster.com>
Date: Fri, 11 Jan 2013 13:41:10 -0500
Subject: [PATCH] ob-tangle: Correctly process tangling of single source block
* lisp/ob-tangle.el
(org-babel-tangle):
- remove un-executed attempt to ask user for file-name if
tangling a single block (`:tangle' always has a value)
- change handling of block accumulation
(org-babel-tangle-collect-block): new function to collect a single block
When attempting to tangle a single block, `org-babel-tangle' would use
`narrow-to-region', causing any header arguments not on the
"#+BEGIN_SRC" line to be excluded from the tangled file.
---
lisp/ob-tangle.el | 166 +++++++++++++++++++++++++++++-------------------------
1 file changed, 90 insertions(+), 76 deletions(-)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 0db4335..725d3af 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -192,18 +192,16 @@ source blocks. Optional argument LANG can be used to limit the
exported source code blocks by language."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
- ;; possibly restrict the buffer to the current code block
(save-restriction
- (when only-this-block
- (unless (org-babel-where-is-src-block-head)
- (error "Point is not currently inside of a code block"))
- (save-match-data
- (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
- target-file)
- (setq target-file
- (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
- (narrow-to-region (match-beginning 0) (match-end 0)))
(save-excursion
+ ;; check if tangle restricted to the current code block and
+ ;; move to beginning of block so begin_src line not
+ ;; included in commments
+ (when only-this-block
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head
+ (goto-char head)
+ (error "Point is not currently inside of a code block"))))
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
@@ -270,7 +268,9 @@ exported source code blocks by language."
(setq block-counter (+ 1 block-counter))
(add-to-list 'path-collector file-name)))))
specs)))
- (org-babel-tangle-collect-blocks lang))
+ (if only-this-block
+ (org-babel-tangle-collect-block 1 t)
+ (org-babel-tangle-collect-blocks lang)))
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
@@ -353,7 +353,7 @@ Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANG can be used to limit the collected source
code blocks by language."
- (let ((block-counter 1) (current-heading "") blocks)
+ (let ((block-counter 1) (current-heading "") blocks by-lang)
(org-babel-map-src-blocks (buffer-file-name)
((lambda (new-heading)
(if (not (string= new-heading current-heading))
@@ -366,73 +366,18 @@ code blocks by language."
(or (nth 4 (org-heading-components))
"(dummy for heading without text)")
(error (buffer-file-name)))))
- (let* ((start-line (save-restriction (widen)
- (+ 1 (line-number-at-pos (point)))))
- (file (buffer-file-name))
- (info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info)))
(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))
- (params (nth 2 info))
- (link ((lambda (link)
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link)))
- (org-no-properties
- (org-store-link nil))))
- (source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- current-heading block-counter))))
- (expand-cmd
- (intern (concat "org-babel-expand-body:" src-lang)))
- (assignments-cmd
- (intern (concat "org-babel-variable-assignments:" src-lang)))
- (body
- ((lambda (body) ;; run the tangle-body-hook
- (with-temp-buffer
- (insert body)
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string)))
- ((lambda (body) ;; expand the body in language specific manner
- (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 (org-babel-noweb-p params :tangle)
- (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
- (funcall
- org-babel-process-comment-text
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) ; sets match data
- (match-end 0))
- (error (point-min)))
- (save-excursion
- (if (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)
- (point-min))))
- (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)))))))
+ ;; 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-collect-block
+ block-counter) by-lang)) blocks))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar
@@ -440,6 +385,75 @@ code blocks by language."
blocks))
blocks))
+(defun org-babel-tangle-collect-block
+ (block-counter &optional only-this-block)
+ "Collect tangled source for current block.
+Returns list of block attributes needed by
+`org-babel-tangle-collect-blocks'. If ONLY-THIS-BLOCK is set,
+then return full association list in format needed for
+`org-babel-tangle' directly."
+ (let* ((info (org-babel-get-src-block-info))
+ (start-line
+ (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (src-lang (nth 0 info))
+ (params (nth 2 info))
+ (link ((lambda (link)
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link)))
+ (org-no-properties
+ (org-store-link nil))))
+ (source-name
+ (intern (or (nth 4 info)
+ (format "%s:%d" (nth 4 (org-heading-components))
+ block-counter))))
+ (expand-cmd
+ (intern (concat "org-babel-expand-body:" src-lang)))
+ (assignments-cmd
+ (intern (concat "org-babel-variable-assignments:" src-lang)))
+ (body
+ ((lambda (body) ;; run the tangle-body-hook
+ (with-temp-buffer
+ (insert body)
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string)))
+ ((lambda (body) ;; expand the body in language specific manner
+ (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 (org-babel-noweb-p params :tangle)
+ (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
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
+ (result
+ (list start-line file link source-name params body comment)))
+ (if only-this-block
+ (list (cons src-lang (list result)))
+ result)))
+
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
--
1.8.0
^ permalink raw reply related [flat|nested] 3+ messages in thread
* [PATCH] ob-tangle: Correctly process tangling of single source block
2013-01-15 19:26 (no subject) Rick Frankel
@ 2013-01-15 20:28 ` Rick Frankel
2013-03-02 16:15 ` Bastien
0 siblings, 1 reply; 3+ messages in thread
From: Rick Frankel @ 2013-01-15 20:28 UTC (permalink / raw)
To: emacs-orgmode
Sorry, subject didn't get properly added:
----------------
* lisp/ob-tangle.el
(org-babel-tangle):
- remove un-executed attempt to ask user for file-name if
tangling a single block (`:tangle' always has a value)
- change handling of block accumulation
(org-babel-tangle-collect-block): new function to collect a single block
When attempting to tangle a single block, `org-babel-tangle' would use
`narrow-to-region', causing any header arguments not on the
"#+BEGIN_SRC" line to be excluded from the tangled file.
---
lisp/ob-tangle.el | 166 +++++++++++++++++++++++++++++-------------------------
1 file changed, 90 insertions(+), 76 deletions(-)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 0db4335..725d3af 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -192,18 +192,16 @@ source blocks. Optional argument LANG can be used to limit the
exported source code blocks by language."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
- ;; possibly restrict the buffer to the current code block
(save-restriction
- (when only-this-block
- (unless (org-babel-where-is-src-block-head)
- (error "Point is not currently inside of a code block"))
- (save-match-data
- (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
- target-file)
- (setq target-file
- (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
- (narrow-to-region (match-beginning 0) (match-end 0)))
(save-excursion
+ ;; check if tangle restricted to the current code block and
+ ;; move to beginning of block so begin_src line not
+ ;; included in commments
+ (when only-this-block
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head
+ (goto-char head)
+ (error "Point is not currently inside of a code block"))))
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
@@ -270,7 +268,9 @@ exported source code blocks by language."
(setq block-counter (+ 1 block-counter))
(add-to-list 'path-collector file-name)))))
specs)))
- (org-babel-tangle-collect-blocks lang))
+ (if only-this-block
+ (org-babel-tangle-collect-block 1 t)
+ (org-babel-tangle-collect-blocks lang)))
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
@@ -353,7 +353,7 @@ Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANG can be used to limit the collected source
code blocks by language."
- (let ((block-counter 1) (current-heading "") blocks)
+ (let ((block-counter 1) (current-heading "") blocks by-lang)
(org-babel-map-src-blocks (buffer-file-name)
((lambda (new-heading)
(if (not (string= new-heading current-heading))
@@ -366,73 +366,18 @@ code blocks by language."
(or (nth 4 (org-heading-components))
"(dummy for heading without text)")
(error (buffer-file-name)))))
- (let* ((start-line (save-restriction (widen)
- (+ 1 (line-number-at-pos (point)))))
- (file (buffer-file-name))
- (info (org-babel-get-src-block-info 'light))
+ (let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info)))
(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))
- (params (nth 2 info))
- (link ((lambda (link)
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link)))
- (org-no-properties
- (org-store-link nil))))
- (source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- current-heading block-counter))))
- (expand-cmd
- (intern (concat "org-babel-expand-body:" src-lang)))
- (assignments-cmd
- (intern (concat "org-babel-variable-assignments:" src-lang)))
- (body
- ((lambda (body) ;; run the tangle-body-hook
- (with-temp-buffer
- (insert body)
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string)))
- ((lambda (body) ;; expand the body in language specific manner
- (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 (org-babel-noweb-p params :tangle)
- (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
- (funcall
- org-babel-process-comment-text
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) ; sets match data
- (match-end 0))
- (error (point-min)))
- (save-excursion
- (if (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)
- (point-min))))
- (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)))))))
+ ;; 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-collect-block
+ block-counter) by-lang)) blocks))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar
@@ -440,6 +385,75 @@ code blocks by language."
blocks))
blocks))
+(defun org-babel-tangle-collect-block
+ (block-counter &optional only-this-block)
+ "Collect tangled source for current block.
+Returns list of block attributes needed by
+`org-babel-tangle-collect-blocks'. If ONLY-THIS-BLOCK is set,
+then return full association list in format needed for
+`org-babel-tangle' directly."
+ (let* ((info (org-babel-get-src-block-info))
+ (start-line
+ (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (src-lang (nth 0 info))
+ (params (nth 2 info))
+ (link ((lambda (link)
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link)))
+ (org-no-properties
+ (org-store-link nil))))
+ (source-name
+ (intern (or (nth 4 info)
+ (format "%s:%d" (nth 4 (org-heading-components))
+ block-counter))))
+ (expand-cmd
+ (intern (concat "org-babel-expand-body:" src-lang)))
+ (assignments-cmd
+ (intern (concat "org-babel-variable-assignments:" src-lang)))
+ (body
+ ((lambda (body) ;; run the tangle-body-hook
+ (with-temp-buffer
+ (insert body)
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string)))
+ ((lambda (body) ;; expand the body in language specific manner
+ (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 (org-babel-noweb-p params :tangle)
+ (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
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
+ (result
+ (list start-line file link source-name params body comment)))
+ (if only-this-block
+ (list (cons src-lang (list result)))
+ result)))
+
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
--
1.8.0
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: [PATCH] ob-tangle: Correctly process tangling of single source block
2013-01-15 20:28 ` [PATCH] ob-tangle: Correctly process tangling of single source block Rick Frankel
@ 2013-03-02 16:15 ` Bastien
0 siblings, 0 replies; 3+ messages in thread
From: Bastien @ 2013-03-02 16:15 UTC (permalink / raw)
To: Rick Frankel; +Cc: emacs-orgmode
Hi Rick,
Rick Frankel <rick@rickster.com> writes:
> Sorry, subject didn't get properly added:
> ----------------
>
> * lisp/ob-tangle.el
> (org-babel-tangle):
> - remove un-executed attempt to ask user for file-name if
> tangling a single block (`:tangle' always has a value)
> - change handling of block accumulation
>
> (org-babel-tangle-collect-block): new function to collect a single block
>
> When attempting to tangle a single block, `org-babel-tangle' would use
> `narrow-to-region', causing any header arguments not on the
> "#+BEGIN_SRC" line to be excluded from the tangled file.
I finally applied a similar patch to fix this issue.
Thanks for catching this!
--
Bastien
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2013-03-02 18:02 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-01-15 19:26 (no subject) Rick Frankel
2013-01-15 20:28 ` [PATCH] ob-tangle: Correctly process tangling of single source block Rick Frankel
2013-03-02 16:15 ` Bastien
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).