Imported Upstream version 8.0.7

1 files changed, 177 insertions, 83 deletions

diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index d17fd34..1aa9c92 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -1,6 +1,6 @@
 ;;; ob-exp.el --- Exportation of org-babel source blocks
 
-;; Copyright (C) 2009-2012  Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
 
 ;; Authors: Eric Schulte
 ;;	Dan Davison
@@ -23,12 +23,10 @@
 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Code:
-(require 'ob)
-(require 'org-exp-blocks)
+(require 'ob-core)
 (eval-when-compile
   (require 'cl))
 
-(defvar obe-marker nil)
 (defvar org-current-export-file)
 (defvar org-babel-lob-one-liner-regexp)
 (defvar org-babel-ref-split-regexp)
@@ -36,23 +34,31 @@
 
 (declare-function org-babel-lob-get-info "ob-lob" ())
 (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
+(declare-function org-between-regexps-p "org"
+		  (start-re end-re &optional lim-up lim-down))
+(declare-function org-get-indentation "org" (&optional line))
 (declare-function org-heading-components "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-in-verbatim-emphasis "org" ())
 (declare-function org-link-search "org" (s &optional type avoid-pos stealth))
 (declare-function org-fill-template "org" (template alist))
-(declare-function org-in-verbatim-emphasis "org" ())
-(declare-function org-in-block-p "org" (names))
-(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
-
-(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
-(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-context "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-escape-code-in-string "org-src" (s))
 
 (defcustom org-export-babel-evaluate t
   "Switch controlling code evaluation during export.
 When set to nil no code will be evaluated as part of the export
-process."
+process.  When set to 'inline-only, only inline code blocks will
+be executed."
   :group 'org-babel
   :version "24.1"
-  :type 'boolean)
+  :type '(choice (const :tag "Never" nil)
+		 (const :tag "Only inline code" inline-only)
+		 (const :tag "Always" t)))
 (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
 
 (defun org-babel-exp-get-export-buffer ()
@@ -87,10 +93,10 @@ process."
        results)))
 (def-edebug-spec org-babel-exp-in-export-file (form body))
 
-(defun org-babel-exp-src-block (body &rest headers)
+(defun org-babel-exp-src-block (&rest headers)
   "Process source block for export.
-Depending on the 'export' headers argument in replace the source
-code block with...
+Depending on the 'export' headers argument, replace the source
+code block like this:
 
 both ---- display the code and the results
 
@@ -100,11 +106,12 @@ code ---- the default, display the code inside the block but do
 results - just like none only the block is run on export ensuring
           that it's results are present in the org-mode buffer
 
-none ----- do not display either code or results upon export"
+none ---- do not display either code or results upon export
+
+Assume point is at the beginning of block's starting line."
   (interactive)
   (unless noninteractive (message "org-babel-exp processing..."))
   (save-excursion
-    (goto-char (match-beginning 0))
     (let* ((info (org-babel-get-src-block-info 'light))
 	   (lang (nth 0 info))
 	   (raw-params (nth 2 info)) hash)
@@ -150,66 +157,153 @@ this template."
       (let ((m (make-marker)))
 	(set-marker m end (current-buffer))
 	(setq end m)))
-    (let ((rx (concat "\\("  org-babel-inline-src-block-regexp
+    (let ((rx (concat "\\(?:"  org-babel-inline-src-block-regexp
 		      "\\|" org-babel-lob-one-liner-regexp "\\)")))
-      (while (and (< (point) (marker-position end))
-		  (re-search-forward rx end t))
-	(if (save-excursion
-	      (goto-char (match-beginning 0))
-	      (looking-at org-babel-inline-src-block-regexp))
-	    (progn
-	      (forward-char 1)
-	      (let* ((info (save-match-data
-			     (org-babel-parse-inline-src-block-match)))
-		     (params (nth 2 info)))
-		(save-match-data
-		  (goto-char (match-beginning 2))
-		  (unless (org-babel-in-example-or-verbatim)
-		    ;; expand noweb references in the original file
-		    (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)))
-		    (let ((code-replacement (save-match-data
-					      (org-babel-exp-do-export
-					       info 'inline))))
-		      (if code-replacement
-			  (progn (replace-match code-replacement nil nil nil 1)
-				 (delete-char 1))
-			(org-babel-examplize-region (match-beginning 1)
-						    (match-end 1))
-			(forward-char 2)))))))
-	  (unless (org-babel-in-example-or-verbatim)
-	    (let* ((lob-info (org-babel-lob-get-info))
-		   (inlinep (match-string 11))
-		   (inline-start (match-end 11))
-		   (inline-end (match-end 0))
-		   (results (save-match-data
-			      (org-babel-exp-do-export
-			       (list "emacs-lisp" "results"
-				     (org-babel-merge-params
-				      org-babel-default-header-args
-				      org-babel-default-lob-header-args
-				      (org-babel-params-from-properties)
-				      (org-babel-parse-header-arguments
-				       (org-no-properties
-					(concat ":var results="
-						(mapconcat #'identity
-							   (butlast lob-info)
-							   " ")))))
-				     "" nil (car (last lob-info)))
-			       'lob)))
-		   (rep (org-fill-template
-			 org-babel-exp-call-line-template
-			 `(("line"  . ,(nth 0 lob-info))))))
-	      (if inlinep
-		  (save-excursion
-		    (goto-char inline-start)
-		    (delete-region inline-start inline-end)
-		    (insert rep))
-		(replace-match rep t t)))))))))
+      (while (re-search-forward rx end t)
+	(save-excursion
+	  (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)))
+	    (when (memq type '(babel-call inline-babel-call inline-src-block))
+	      (let ((beg-el (org-element-property :begin element))
+		    (end-el (org-element-property :end element)))
+		(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 beg-el)
+		     (let ((replacement (org-babel-exp-do-export info 'inline)))
+		       (if (equal replacement "")
+			   ;; Replacement code is empty: completely
+			   ;; remove inline src block, including extra
+			   ;; white space that might have been created
+			   ;; when inserting results.
+			   (delete-region beg-el
+					  (progn (goto-char end-el)
+						 (skip-chars-forward " \t")
+						 (point)))
+			 ;; Otherwise: remove inline src block but
+			 ;; preserve following white spaces.  Then
+			 ;; insert value.
+			 (delete-region beg-el
+					(progn (goto-char end-el)
+					       (skip-chars-backward " \t")
+					       (point)))
+			 (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"
+				  (org-babel-merge-params
+				   org-babel-default-header-args
+				   org-babel-default-lob-header-args
+				   (org-babel-params-from-properties)
+				   (org-babel-parse-header-arguments
+				    (org-no-properties
+				     (concat ":var results="
+					     (mapconcat 'identity
+							(butlast lob-info)
+							" ")))))
+				  "" nil (car (last 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
+			  beg-el
+			  (progn (goto-char end-el)
+				 (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 beg-el)
+		       (delete-region beg-el
+				      (progn (goto-char end-el)
+					     (skip-chars-backward " \r\t\n")
+					     (point)))
+		       (insert rep)))))))))))))
+
+(defvar org-src-preserve-indentation)	; From org-src.el
+(defun org-babel-exp-process-buffer ()
+  "Execute all blocks in visible part of buffer."
+  (interactive)
+  (save-window-excursion
+    (let ((case-fold-search t)
+	  (pos (point-min)))
+      (goto-char pos)
+      (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t)
+        (let ((element (save-match-data (org-element-at-point))))
+          (when (eq (org-element-type element) 'src-block)
+            (let* ((match-start (copy-marker (match-beginning 0)))
+                   (begin (copy-marker (org-element-property :begin element)))
+                   ;; Make sure we don't remove any blank lines after
+                   ;; the block when replacing it.
+                   (block-end (save-excursion
+				(goto-char (org-element-property :end element))
+				(skip-chars-backward " \r\t\n")
+				(copy-marker (line-end-position))))
+                   (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]+"))))))
+              ;; Execute all non-block elements between POS and
+              ;; current block.
+              (org-babel-exp-non-block-elements pos begin)
+	      ;; 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 block-end))
+		      ((equal replacement "")
+		       (delete-region begin
+				      (progn (goto-char block-end)
+					     (skip-chars-forward " \r\t\n")
+					     (if (eobp) (point)
+					       (line-beginning-position)))))
+		      (t
+		       (goto-char match-start)
+		       (delete-region (point) block-end)
+		       (insert replacement)
+		       (if (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)))))
+	      (setq pos (line-beginning-position))
+              ;; Cleanup markers.
+	      (set-marker match-start nil)
+	      (set-marker begin nil)
+              (set-marker block-end nil)))))
+      ;; Eventually execute all non-block Babel elements between last
+      ;; src-block and end of buffer.
+      (org-babel-exp-non-block-elements pos (point-max)))))
 
 (defun org-babel-in-example-or-verbatim ()
   "Return true if point is in example or verbatim code.
@@ -270,9 +364,7 @@ replaced with its value."
   (org-fill-template
    org-babel-exp-code-template
    `(("lang"  . ,(nth 0 info))
-     ("body"  . ,(if (string= (nth 0 info) "org")
-		     (replace-regexp-in-string "^" "," (nth 1 info))
-		   (nth 1 info)))
+     ("body"  . ,(org-escape-code-in-string (nth 1 info)))
      ,@(mapcar (lambda (pair)
 		 (cons (substring (symbol-name (car pair)) 1)
 		       (format "%S" (cdr pair))))
@@ -286,7 +378,9 @@ Results are prepared in a manner suitable for export by org-mode.
 This function is called by `org-babel-exp-do-export'.  The code
 block will be evaluated.  Optional argument SILENT can be used to
 inhibit insertion of results into the buffer."
-  (when (and org-export-babel-evaluate
+  (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)))))
     (let ((lang (nth 0 info))
 	  (body (if (org-babel-noweb-p (nth 2 info) :eval)
@@ -319,10 +413,10 @@ inhibit insertion of results into the buffer."
 	   ((equal type 'lob)
 	    (save-excursion
 	      (re-search-backward org-babel-lob-one-liner-regexp nil t)
-	      (org-babel-execute-src-block nil info)))))))))
-
-(provide 'ob-exp)
+	      (let (org-confirm-babel-evaluate)
+		(org-babel-execute-src-block nil info))))))))))
 
 
+(provide 'ob-exp)
 
 ;;; ob-exp.el ends here