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

[Nicolas Goaziou]

Hello,

Eric Schulte <address@hidden> 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

>From dadb93605aaef5b77837227ddd18b6e2448a00f1 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
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

>From fbb6fd01568a6cc25a7c8b06f0210dce1685742c Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
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