Browse Source

Fix `org-export-babel-evaluate' handling

* lisp/ob-exp.el (org-babel-exp-process-buffer): Handle
  `org-export-babel-evaluate' handling.
(org-babel-exp-results): Ignore `org-export-babel-evaluate' since it is
handled as a higher level.

* lisp/ox.el (org-export-as): Allow to short-circuit babel evaluation if
  `org-export-babel-evaluate' is nil.

* testing/lisp/test-ob-exp.el (ob-export/babel-evaluate): New test.

Reported-by: Nicolas Richard <nrichard@ulb.ac.be>
<http://permalink.gmane.org/gmane.emacs.orgmode/106767>
Nicolas Goaziou 9 years ago
parent
commit
ec615b192d
3 changed files with 189 additions and 138 deletions
  1. 135 135
      lisp/ob-exp.el
  2. 4 3
      lisp/ox.el
  3. 50 0
      testing/lisp/test-ob-exp.el

+ 135 - 135
lisp/ob-exp.el

@@ -159,135 +159,138 @@ buffer being processed.  It is used to properly resolve
 references in source blocks, as modifications in current buffer
 references in source blocks, as modifications in current buffer
 may make them unreachable."
 may make them unreachable."
   (interactive)
   (interactive)
-  (save-window-excursion
-    (save-excursion
-      (let ((case-fold-search t)
-	    (org-babel-exp-reference-buffer reference-buffer)
-	    (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
-	(goto-char (point-min))
-	(while (re-search-forward regexp nil t)
-	  (unless (save-match-data (org-in-commented-heading-p))
-	    (let* ((element (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-get-src-block-info nil element))
-			(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-reference-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
-			 ;; 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 element))
-			(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 2 lob-info) (nth 3 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.
+  (when org-export-babel-evaluate
+    (save-window-excursion
+      (save-excursion
+	(let ((case-fold-search t)
+	      (org-babel-exp-reference-buffer reference-buffer)
+	      (regexp
+	       (if (eq org-export-babel-evaluate 'inline-only)
+		   "\\(call\\|src\\)_"
+		 "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")))
+	  (goto-char (point-min))
+	  (while (re-search-forward regexp nil t)
+	    (unless (save-match-data (org-in-commented-heading-p))
+	      (let* ((element (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-get-src-block-info nil element))
+			  (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-reference-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))
-			(lang (or (org-element-property :language element)
-				  (user-error
-				   "No language for src block: %s"
-				   (or (org-element-property :name element)
-				       "(unnamed)"))))
-			(headers
-			 (cons lang
-			       (let ((params
-				      (org-element-property
-				       :parameters element)))
-				 (and params (org-split-string params))))))
-		   ;; 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 element))
+			  (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 2 lob-info) (nth 3 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 trailing 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))
+			  (lang (or (org-element-property :language element)
+				    (user-error
+				     "No language for src block: %s"
+				     (or (org-element-property :name element)
+					 "(unnamed)"))))
+			  (headers
+			   (cons lang
+				 (let ((params
+					(org-element-property
+					 :parameters element)))
+				   (and params (org-split-string params))))))
+		     ;; Take care of matched block: compute
+		     ;; replacement string.  In particular, a nil
+		     ;; REPLACEMENT means the block is left as-is
+		     ;; while an empty string removes 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 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-exp-do-export (info type &optional hash)
 (defun org-babel-exp-do-export (info type &optional hash)
   "Return a string with the exported content of a code block.
   "Return a string with the exported content of a code block.
@@ -380,10 +383,7 @@ Results are prepared in a manner suitable for export by Org mode.
 This function is called by `org-babel-exp-do-export'.  The code
 This function is called by `org-babel-exp-do-export'.  The code
 block will be evaluated.  Optional argument SILENT can be used to
 block will be evaluated.  Optional argument SILENT can be used to
 inhibit insertion of results into the buffer."
 inhibit insertion of results into the buffer."
-  (when (and (or (eq org-export-babel-evaluate t)
-		 (and (eq type 'inline)
-		      (eq org-export-babel-evaluate 'inline-only)))
-	     (not (and hash (equal hash (org-babel-current-result-hash)))))
+  (unless (and hash (equal hash (org-babel-current-result-hash)))
     (let ((lang (nth 0 info))
     (let ((lang (nth 0 info))
 	  (body (if (org-babel-noweb-p (nth 2 info) :eval)
 	  (body (if (org-babel-noweb-p (nth 2 info) :eval)
 		    (org-babel-expand-noweb-references
 		    (org-babel-expand-noweb-references
@@ -412,9 +412,9 @@ inhibit insertion of results into the buffer."
 	      (org-babel-execute-src-block nil info))
 	      (org-babel-execute-src-block nil info))
 	    (`lob
 	    (`lob
 	     (save-excursion
 	     (save-excursion
-	      (goto-char (nth 5 info))
-	      (let (org-confirm-babel-evaluate)
-		(org-babel-execute-src-block nil info))))))))))
+	       (goto-char (nth 5 info))
+	       (let (org-confirm-babel-evaluate)
+		 (org-babel-execute-src-block nil info))))))))))
 
 
 
 
 (provide 'ob-exp)
 (provide 'ob-exp)

+ 4 - 3
lisp/ox.el

@@ -3013,9 +3013,10 @@ Return code as a string."
 	 ;; again after executing Babel code.
 	 ;; again after executing Babel code.
 	 (org-set-regexps-and-options)
 	 (org-set-regexps-and-options)
 	 (org-update-radio-target-regexp)
 	 (org-update-radio-target-regexp)
-	 (org-export-execute-babel-code)
-	 (org-set-regexps-and-options)
-	 (org-update-radio-target-regexp)
+	 (when org-export-babel-evaluate
+	   (org-export-execute-babel-code)
+	   (org-set-regexps-and-options)
+	   (org-update-radio-target-regexp))
 	 ;; Run last hook with current back-end's name as argument.
 	 ;; Run last hook with current back-end's name as argument.
 	 ;; Update buffer properties and radio targets one last time
 	 ;; Update buffer properties and radio targets one last time
 	 ;; before parsing.
 	 ;; before parsing.

+ 50 - 0
testing/lisp/test-ob-exp.el

@@ -514,6 +514,56 @@ src_emacs-lisp{(+ 1 1)}"
 #+END_SRC"
 #+END_SRC"
      (org-export-execute-babel-code) t)))
      (org-export-execute-babel-code) t)))
 
 
+(ert-deftest ob-export/babel-evaluate ()
+  "Test `org-export-babel-evaluate' effect."
+  ;; When nil, no Babel code is executed.
+  (should-not
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
+      (let ((org-export-babel-evaluate nil)) (org-export-execute-babel-code))
+      (buffer-string))))
+  (should-not
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"src_emacs-lisp{(+ 1 1)}"
+      (let ((org-export-babel-evaluate nil)) (org-export-execute-babel-code))
+      (buffer-string))))
+  ;; When non-nil, all Babel code types are executed.
+  (should
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
+      (let ((org-export-babel-evaluate t)) (org-export-execute-babel-code))
+      (buffer-string))))
+  (should
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"src_emacs-lisp{(+ 1 1)}"
+      (let ((org-export-babel-evaluate t)) (org-export-execute-babel-code))
+      (buffer-string))))
+  ;; When set to `inline-only' limit evaluation to inline code.
+  (should-not
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
+      (let ((org-export-babel-evaluate 'inline-only))
+	(org-export-execute-babel-code))
+      (buffer-string))))
+  (should
+   (string-match-p
+    "2"
+    (org-test-with-temp-text
+	"src_emacs-lisp{(+ 1 1)}"
+      (let ((org-export-babel-evaluate 'inline-only))
+	(org-export-execute-babel-code))
+      (buffer-string)))))
+
 
 
 (provide 'test-ob-exp)
 (provide 'test-ob-exp)