Merge branch 'master' of orgmode.org:org-mode

doc/org.texi

@@ -9752,8 +9752,9 @@ a horizontal line.
 Lines starting with zero or more whitespace characters followed by one
 @samp{#} and a whitespace are treated as comments and will never be exported.
 Also entire subtrees starting with the word @samp{COMMENT} will never be
-exported.  Finally, regions surrounded by @samp{#+BEGIN_COMMENT}
-... @samp{#+END_COMMENT} will not be exported.
+exported (and included code blocks will not be executed on export).  Finally,
+regions surrounded by @samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will
+not be exported.
 
 @table @kbd
 @kindex C-c ;
@@ -10547,7 +10548,8 @@ anywhere in a file, text before the first headline is ignored.
 The tags that exclude a tree from export (@code{org-export-exclude-tags}).
 The default value is @code{:noexport:}.  Entries with the @code{:noexport:}
 tag will be unconditionally excluded from the export, even if they have an
-@code{:export:} tag.
+@code{:export:} tag.  Code blocks contained in excluded subtrees will still
+be executed during export even thought the subtree is not exported.
 
 @item TITLE
 @cindex #+TITLE
@@ -13867,6 +13869,10 @@ assumed to have their results already inserted in the buffer by manual
 evaluation.  This setting is useful to avoid expensive recalculations during
 export, not to provide security.
 
+Code blocks in commented subtrees (e.g., with the @code{COMMENT} keyword)
+(@pxref{Horizontal rules}) are never evaluated on export.  However, code
+blocks in subtrees excluded from export (@pxref{Export settings}) may be
+evaluated on export.
 
 @node Extracting source code
 @section Extracting source code

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.

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))))))
 

lisp/ox-html.el

@@ -169,10 +169,8 @@
     "progress" "section" "video")
   "New elements in html5.
 
-<hgroup> is not included because it's currently impossible to
-wrap special blocks around multiple headlines. For other blocks
-that should contain headlines, use the HTML_CONTAINER property on
-the headline itself.")
+For blocks that should contain headlines, use the HTML_CONTAINER
+property on the headline itself.")
 
 (defconst org-html-special-string-regexps
   '(("\\\\-" . "&#x00ad;")		; shy

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