emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: rick@rickster.com (Rick Frankel)
To: emacs-orgmode@gnu.org
Subject: (no subject)
Date: Tue, 15 Jan 2013 14:26:41 -0500 (EST)	[thread overview]
Message-ID: <20130115192641.734AA1BA269D@BigDog.local> (raw)

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

             reply	other threads:[~2013-01-15 20:06 UTC|newest]

Thread overview: 95+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-01-15 19:26 Rick Frankel [this message]
2013-01-15 20:28 ` [PATCH] ob-tangle: Correctly process tangling of single source block Rick Frankel
2013-03-02 16:15   ` Bastien
  -- strict thread matches above, loose matches on Subject: below --
2019-02-04  3:40 (no subject) Lawrence Bottorff
2018-12-19 12:58 Emmanuel Charpentier
2018-10-20  9:02 stardiviner
2018-10-15  8:04 Nik Clayton
2018-10-17 13:20 ` Nicolas Goaziou
2019-09-15 21:06 ` Matt Price
2018-05-03 13:44 Arne Babenhauserheide
2018-05-03 14:29 ` Bastien
2018-05-03 21:02   ` Arne Babenhauserheide
2018-05-04  1:02     ` steen
2018-05-04  5:38   ` Michael Welle
2018-05-11 20:07 ` Nicolas Goaziou
2018-03-02 16:10 Joseph Vidal-Rosset
2016-11-01 16:10 John Kitchin
2016-09-19 16:38 John Brodie
2016-09-20 20:32 ` Nicolas Goaziou
2015-11-03 19:53 Fritz Kunze
2015-10-11 19:51 Shankar Rao
2015-09-04 14:51 Eduardo Mercovich
2015-09-04 15:25 ` thomas
2015-09-04 18:35   ` Eduardo Mercovich
2015-01-24 16:23 M.S.Khed Khed
2014-05-03  1:52 Ryan Moszynski
2014-05-03  3:01 ` William Henney
2014-05-03  3:22   ` William Henney
2014-01-30  0:03 Ken Okada
2014-01-30  0:15 ` Bastien
2014-01-30  0:22   ` John Hendy
2014-01-30  7:17     ` Ken Okada
2014-01-31  6:29       ` John Hendy
2014-01-31  7:11         ` Nick Dokos
2014-02-03 22:13           ` Marcin Borkowski
2013-11-06  6:13 Cecil Westerhof
2013-11-06  8:32 ` Bastien
2013-11-06  8:42 ` Bastien
     [not found]   ` <CAG-LmmDGaczy8pyeCTU6-YJ9oTBeEufqU6kC2PUb-U6ucexhZA@mail.gmail.com>
     [not found]     ` <87txfpaeli.fsf@bzg.ath.cx>
     [not found]       ` <CAG-LmmDFjqbuqfF1YJoeX6x_UdujK+0noeFcGSD15hs49Tbo=Q@mail.gmail.com>
2013-11-06 18:38         ` Cecil Westerhof
2013-10-11  7:14 "Recent items" Agenda view? Martin Beck
2013-10-11 20:35 ` Samuel Wales
2013-10-14  8:46   ` (no subject) Martin Beck
2013-03-07 20:37 [RFC] Org syntax (draft) Nicolas Goaziou
2013-03-08 10:39 ` was: " Andreas Röhler
2013-03-08 10:46   ` (no subject) Bastien
2013-03-08 10:59     ` Andreas Röhler
2013-03-08 11:05       ` Bastien
2013-03-08 11:18         ` Andreas Röhler
2013-03-08 11:23           ` Bastien
2013-03-08 13:00             ` Andreas Röhler
2013-03-08 13:12               ` Bastien
2013-03-08 15:22                 ` Andreas Röhler
2013-03-08 15:40                   ` Bastien
2013-03-08 20:39                     ` T.F. Torrey
2013-03-08 21:19                       ` Nicolas Goaziou
2013-03-08 21:57                         ` Suvayu Ali
2013-03-09 14:09                       ` Bastien
2013-03-10 22:40                         ` T.F. Torrey
2013-03-03  0:55 Vikas Rawal
2013-01-29  9:43 Martin Beck
2013-01-30 12:12 ` Bernt Hansen
2013-01-24 12:11 Herbert Sitz
2012-11-11 15:36 Fabrice Popineau
2012-11-11 23:09 ` Nicolas Goaziou
2012-11-12  7:40   ` Fabrice Popineau
2012-11-07 18:50 Kevin Buchs
2012-09-29  7:30 Neuwirth Erich
2012-09-29  7:39 ` Bastien
2012-09-29  8:09   ` Achim Gratz
2012-09-29  9:12     ` Bastien
2012-09-29  9:52 ` Achim Gratz
2012-08-24 16:21 Feiming Chen
2012-05-22  3:32 "Smart" quotes Mark E. Shoulson
2012-05-23 22:17 ` Nicolas Goaziou
2012-05-24  3:05   ` Mark E. Shoulson
2012-05-25 17:14     ` Nicolas Goaziou
2012-05-25 22:51       ` Mark E. Shoulson
2012-05-26  6:48         ` Nicolas Goaziou
2012-05-29  1:30           ` Mark E. Shoulson
2012-05-29 17:57             ` Nicolas Goaziou
2012-05-30  0:51               ` Mark E. Shoulson
2012-05-31  1:50                 ` (no subject) Mark Shoulson
2012-05-31 13:38                   ` Nicolas Goaziou
2012-05-11 20:56 Rick Frankel
2012-05-11 20:38 ` Eric Schulte
2012-05-11 22:43   ` Bernt Hansen
2012-05-17  6:23   ` Bastien
2012-01-23 12:00 Tom Regner
2012-01-23 16:34 ` Tom Regner
2012-01-23 20:31 ` Eric Schulte
2012-01-24  1:55   ` Tom Regner
2012-01-05 17:36 Ab Cd
2011-08-06  1:19 Vikas Rawal
2011-02-21 22:13 Vincent-Xavier JUMEL
2011-02-23 19:52 ` Bernt Hansen
2011-02-23 19:54 ` Bernt Hansen
2011-04-09  9:41   ` Vincent-Xavier JUMEL
2010-06-29 17:50 amscopub-mail
2009-09-18 12:35 Robin Green
2009-02-17 18:57 Matthew Lundin
2009-02-17 20:26 ` Carsten Dominik
2008-01-28 11:20 Dimitris Kapetanakis
2008-01-29  9:39 ` Bastien Guerry
2007-11-13 20:35 François Puitg
2007-10-20 10:33 Kevin Brubeck Unhammer
2007-10-21 22:20 ` Bastien
2006-05-25 10:43 Thomas Baumann
2006-05-25 12:49 ` Carsten Dominik

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20130115192641.734AA1BA269D@BigDog.local \
    --to=rick@rickster.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).