Re: Babel should not work in the subtree marked as not exported

[Nicolas Goaziou <n.goaziou@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 617 bytes --]

Hello,

Eric Schulte <schulte.eric@gmail.com> writes:

> This sounds like a good compromise to me.  As you say, this should
> easily and visually support both use cases and is intuitive.  I've not
> touched the export machinery myself, so I'll leave the implementation to
> Nicolas but I definitely support this approach.

Here are the patches, with tests. I leave to someone else the
documentation part in the manual.

As a side note, I think `org-babel-under-commented-heading-p' is useful
enough (with an optional parameter to prevent inheritance, maybe) to be
moved into "org.el".


Regards,

-- 
Nicolas Goaziou

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-tangle-Fix-org-babel-under-commented-heading-p.patch --]
[-- Type: text/x-diff, Size: 1507 bytes --]

From dadb93605aaef5b77837227ddd18b6e2448a00f1 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Sat, 15 Mar 2014 15:32:59 +0100
Subject: [PATCH 1/2] ob-tangle: Fix `org-babel-under-commented-heading-p'

* lisp/ob-tangle.el (org-babel-under-commented-heading-p):
  `org-comment-string' is case sensitive and cannot be attached to
  other text.
---
 lisp/ob-tangle.el | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 2910d7f..bf67410 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -359,12 +359,17 @@ that the appropriate major-mode is set.  SPEC has the form:
 
 (defvar org-comment-string) ;; Defined in org.el
 (defun org-babel-under-commented-heading-p ()
-  "Return t if currently under a commented heading."
-  (unless (org-before-first-heading-p)
-    (if (let ((hd (nth 4 (org-heading-components))))
-	  (and hd (string-match (concat "^" org-comment-string) hd)))
-	t
-      (save-excursion
+  "Non-nil if point is under a commented heading.
+This function also checks ancestors of the current headline, if
+any."
+  (cond
+   ((org-before-first-heading-p) nil)
+   ((let ((headline (nth 4 (org-heading-components))))
+      (and headline
+	   (let ((case-fold-search nil))
+	     (org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
+				 headline)))))
+   (t (save-excursion
 	(and (org-up-heading-safe)
 	     (org-babel-under-commented-heading-p))))))
 
-- 
1.9.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-ob-exp-During-export-ignore-Babel-code-under-comment.patch --]
[-- Type: text/x-diff, Size: 11461 bytes --]

From fbb6fd01568a6cc25a7c8b06f0210dce1685742c Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Sat, 15 Mar 2014 09:34:05 +0100
Subject: [PATCH 2/2] ob-exp: During export ignore Babel code under commented
 headlines

* lisp/ob-exp.el (org-babel-exp-process-buffer): Skip code under
  a commented headline.
* testing/lisp/test-ob-exp.el (ob-export/export-under-commented-headline):
  New test.
---
 lisp/ob-exp.el              | 242 ++++++++++++++++++++++----------------------
 testing/lisp/test-ob-exp.el |  50 +++++++++
 2 files changed, 172 insertions(+), 120 deletions(-)

diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 09ae827..38618ee 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -163,127 +163,129 @@ this template."
 			    "^[ \t]*#\\+BEGIN_SRC")))
 	(goto-char (point-min))
 	(while (re-search-forward regexp nil t)
-	  (let* ((element (save-excursion
-			    ;; If match is inline, point is at its
-			    ;; end.  Move backward so
-			    ;; `org-element-context' can get the
-			    ;; object, not the following one.
-			    (backward-char)
-			    (save-match-data (org-element-context))))
-		 (type (org-element-type element))
-		 (begin (copy-marker (org-element-property :begin element)))
-		 (end (copy-marker
-		       (save-excursion
-			 (goto-char (org-element-property :end element))
-			 (skip-chars-backward " \r\t\n")
-			 (point)))))
-	    (case type
-	      (inline-src-block
-	       (let* ((info (org-babel-parse-inline-src-block-match))
-		      (params (nth 2 info)))
-		 (setf (nth 1 info)
-		       (if (and (cdr (assoc :noweb params))
-				(string= "yes" (cdr (assoc :noweb params))))
-			   (org-babel-expand-noweb-references
-			    info (org-babel-exp-get-export-buffer))
-			 (nth 1 info)))
-		 (goto-char begin)
-		 (let ((replacement (org-babel-exp-do-export info 'inline)))
-		   (if (equal replacement "")
-		       ;; Replacement code is empty: remove inline src
-		       ;; block, including extra white space that
-		       ;; might have been created when inserting
-		       ;; results.
-		       (delete-region begin
-				      (progn (goto-char end)
-					     (skip-chars-forward " \t")
-					     (point)))
-		     ;; Otherwise: remove inline src block but
-		     ;; preserve following white spaces.  Then insert
-		     ;; value.
-		     (delete-region begin end)
-		     (insert replacement)))))
-	      ((babel-call inline-babel-call)
-	       (let* ((lob-info (org-babel-lob-get-info))
-		      (results
-		       (org-babel-exp-do-export
-			(list "emacs-lisp" "results"
-			      (apply #'org-babel-merge-params
-				     org-babel-default-header-args
-				     org-babel-default-lob-header-args
-				     (append
-				      (org-babel-params-from-properties)
-				      (list
-				       (org-babel-parse-header-arguments
-					(org-no-properties
-					 (concat
-					  ":var results="
-					  (mapconcat 'identity
-						     (butlast lob-info 2)
-						     " ")))))))
-			      "" (nth 3 lob-info) (nth 2 lob-info))
-			'lob))
-		      (rep (org-fill-template
-			    org-babel-exp-call-line-template
-			    `(("line"  . ,(nth 0 lob-info))))))
-		 ;; If replacement is empty, completely remove the
-		 ;; object/element, including any extra white space
-		 ;; that might have been created when including
-		 ;; results.
-		 (if (equal rep "")
-		     (delete-region
-		      begin
-		      (progn (goto-char end)
-			     (if (not (eq type 'babel-call))
-				 (progn (skip-chars-forward " \t") (point))
-			       (skip-chars-forward " \r\t\n")
-			       (line-beginning-position))))
-		   ;; Otherwise, preserve following white
-		   ;; spaces/newlines and then, insert replacement
-		   ;; string.
+	  (unless (save-match-data (org-babel-under-commented-heading-p))
+	    (let* ((element (save-excursion
+			      ;; If match is inline, point is at its
+			      ;; end.  Move backward so
+			      ;; `org-element-context' can get the
+			      ;; object, not the following one.
+			      (backward-char)
+			      (save-match-data (org-element-context))))
+		   (type (org-element-type element))
+		   (begin (copy-marker (org-element-property :begin element)))
+		   (end (copy-marker
+			 (save-excursion
+			   (goto-char (org-element-property :end element))
+			   (skip-chars-backward " \r\t\n")
+			   (point)))))
+	      (case type
+		(inline-src-block
+		 (let* ((info (org-babel-parse-inline-src-block-match))
+			(params (nth 2 info)))
+		   (setf (nth 1 info)
+			 (if (and (cdr (assoc :noweb params))
+				  (string= "yes" (cdr (assoc :noweb params))))
+			     (org-babel-expand-noweb-references
+			      info (org-babel-exp-get-export-buffer))
+			   (nth 1 info)))
 		   (goto-char begin)
-		   (delete-region begin end)
-		   (insert rep))))
-	      (src-block
-	       (let* ((match-start (copy-marker (match-beginning 0)))
-		      (ind (org-get-indentation))
-		      (headers
-		       (cons
-			(org-element-property :language element)
-			(let ((params (org-element-property :parameters
-							    element)))
-			  (and params (org-split-string params "[ \t]+"))))))
-		 ;; Take care of matched block: compute replacement
-		 ;; string.  In particular, a nil REPLACEMENT means
-		 ;; the block should be left as-is while an empty
-		 ;; string should remove the block.
-		 (let ((replacement (progn (goto-char match-start)
-					   (org-babel-exp-src-block headers))))
-		   (cond ((not replacement) (goto-char end))
-			 ((equal replacement "")
-			  (goto-char end)
-			  (skip-chars-forward " \r\t\n")
-			  (beginning-of-line)
-			  (delete-region begin (point)))
-			 (t
-			  (goto-char match-start)
-			  (delete-region (point)
-					 (save-excursion (goto-char end)
-							 (line-end-position)))
-			  (insert replacement)
-			  (if (or org-src-preserve-indentation
-				  (org-element-property :preserve-indent
-							element))
-			      ;; Indent only the code block markers.
-			      (save-excursion (skip-chars-backward " \r\t\n")
-					      (indent-line-to ind)
-					      (goto-char match-start)
-					      (indent-line-to ind))
-			    ;; Indent everything.
-			    (indent-rigidly match-start (point) ind)))))
-		 (set-marker match-start nil))))
-	    (set-marker begin nil)
-	    (set-marker end nil)))))))
+		   (let ((replacement (org-babel-exp-do-export info 'inline)))
+		     (if (equal replacement "")
+			 ;; Replacement code is empty: remove inline
+			 ;; source block, including extra white space
+			 ;; that might have been created when
+			 ;; inserting results.
+			 (delete-region begin
+					(progn (goto-char end)
+					       (skip-chars-forward " \t")
+					       (point)))
+		       ;; Otherwise: remove inline src block but
+		       ;; preserve following white spaces.  Then
+		       ;; insert value.
+		       (delete-region begin end)
+		       (insert replacement)))))
+		((babel-call inline-babel-call)
+		 (let* ((lob-info (org-babel-lob-get-info))
+			(results
+			 (org-babel-exp-do-export
+			  (list "emacs-lisp" "results"
+				(apply #'org-babel-merge-params
+				       org-babel-default-header-args
+				       org-babel-default-lob-header-args
+				       (append
+					(org-babel-params-from-properties)
+					(list
+					 (org-babel-parse-header-arguments
+					  (org-no-properties
+					   (concat
+					    ":var results="
+					    (mapconcat 'identity
+						       (butlast lob-info 2)
+						       " ")))))))
+				"" (nth 3 lob-info) (nth 2 lob-info))
+			  'lob))
+			(rep (org-fill-template
+			      org-babel-exp-call-line-template
+			      `(("line"  . ,(nth 0 lob-info))))))
+		   ;; If replacement is empty, completely remove the
+		   ;; object/element, including any extra white space
+		   ;; that might have been created when including
+		   ;; results.
+		   (if (equal rep "")
+		       (delete-region
+			begin
+			(progn (goto-char end)
+			       (if (not (eq type 'babel-call))
+				   (progn (skip-chars-forward " \t") (point))
+				 (skip-chars-forward " \r\t\n")
+				 (line-beginning-position))))
+		     ;; Otherwise, preserve following white
+		     ;; spaces/newlines and then, insert replacement
+		     ;; string.
+		     (goto-char begin)
+		     (delete-region begin end)
+		     (insert rep))))
+		(src-block
+		 (let* ((match-start (copy-marker (match-beginning 0)))
+			(ind (org-get-indentation))
+			(headers
+			 (cons
+			  (org-element-property :language element)
+			  (let ((params (org-element-property :parameters
+							      element)))
+			    (and params (org-split-string params "[ \t]+"))))))
+		   ;; Take care of matched block: compute replacement
+		   ;; string.  In particular, a nil REPLACEMENT means
+		   ;; the block should be left as-is while an empty
+		   ;; string should remove the block.
+		   (let ((replacement
+			  (progn (goto-char match-start)
+				 (org-babel-exp-src-block headers))))
+		     (cond ((not replacement) (goto-char end))
+			   ((equal replacement "")
+			    (goto-char end)
+			    (skip-chars-forward " \r\t\n")
+			    (beginning-of-line)
+			    (delete-region begin (point)))
+			   (t
+			    (goto-char match-start)
+			    (delete-region (point)
+					   (save-excursion (goto-char end)
+							   (line-end-position)))
+			    (insert replacement)
+			    (if (or org-src-preserve-indentation
+				    (org-element-property :preserve-indent
+							  element))
+				;; Indent only the code block markers.
+				(save-excursion (skip-chars-backward " \r\t\n")
+						(indent-line-to ind)
+						(goto-char match-start)
+						(indent-line-to ind))
+			      ;; Indent everything.
+			      (indent-rigidly match-start (point) ind)))))
+		   (set-marker match-start nil))))
+	      (set-marker begin nil)
+	      (set-marker end nil))))))))
 
 (defun org-babel-in-example-or-verbatim ()
   "Return true if point is in example or verbatim code.
diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el
index 8345da7..d5db187 100644
--- a/testing/lisp/test-ob-exp.el
+++ b/testing/lisp/test-ob-exp.el
@@ -356,6 +356,56 @@ Here is one at the end of a line. =2=
 	(org-export-execute-babel-code)
 	(buffer-string))))))
 
+(ert-deftest ob-export/export-under-commented-headline ()
+  "Test evaluation of code blocks under COMMENT headings."
+  ;; Do not eval block in a commented headline.
+  (should
+   (string-match
+    ": 2"
+    (org-test-with-temp-text "* Headline
+#+BEGIN_SRC emacs-lisp :exports results
+\(+ 1 1)
+#+END_SRC"
+      (org-export-execute-babel-code)
+      (buffer-string))))
+  (should-not
+   (string-match
+    ": 2"
+    (org-test-with-temp-text "* COMMENT Headline
+#+BEGIN_SRC emacs-lisp :exports results
+\(+ 1 1)
+#+END_SRC"
+      (org-export-execute-babel-code)
+      (buffer-string))))
+  ;; Do not eval inline blocks either.
+  (should
+   (string-match
+    "=2="
+    (org-test-with-temp-text "* Headline
+src_emacs-lisp{(+ 1 1)}"
+      (org-export-execute-babel-code)
+      (buffer-string))))
+  (should-not
+   (string-match
+    "=2="
+    (org-test-with-temp-text "* COMMENT Headline
+src_emacs-lisp{(+ 1 1)}"
+      (org-export-execute-babel-code)
+      (buffer-string))))
+  ;; Also check parent headlines.
+  (should-not
+   (string-match
+    ": 2"
+    (org-test-with-temp-text "
+* COMMENT Headline
+** Children
+#+BEGIN_SRC emacs-lisp :exports results
+\(+ 1 1)
+#+END_SRC"
+      (org-export-execute-babel-code)
+      (buffer-string)))))
+
+
 (provide 'test-ob-exp)
 
 ;;; test-ob-exp.el ends here
-- 
1.9.0