Browse Source

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.
Nicolas Goaziou 11 years ago
parent
commit
05f69e5bf8
2 changed files with 172 additions and 120 deletions
  1. 122 120
      lisp/ob-exp.el
  2. 50 0
      testing/lisp/test-ob-exp.el

+ 122 - 120
lisp/ob-exp.el

@@ -163,127 +163,129 @@ this template."
 			    "^[ \t]*#\\+BEGIN_SRC")))
 			    "^[ \t]*#\\+BEGIN_SRC")))
 	(goto-char (point-min))
 	(goto-char (point-min))
 	(while (re-search-forward regexp nil t)
 	(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)
 		   (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 ()
 (defun org-babel-in-example-or-verbatim ()
   "Return true if point is in example or verbatim code.
   "Return true if point is in example or verbatim code.

+ 50 - 0
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)
 	(org-export-execute-babel-code)
 	(buffer-string))))))
 	(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)
 (provide 'test-ob-exp)
 
 
 ;;; test-ob-exp.el ends here
 ;;; test-ob-exp.el ends here