summaryrefslogtreecommitdiff
path: root/lisp/ob-exp.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
commite32a45ed36d6000db4b39171149072d11b77af72 (patch)
treeb5f4a7d43022c08c3298e82b3e9fc50f68be660f /lisp/ob-exp.el
parent7697fa4daf3ec84f85711a84035d8f0224afd4e3 (diff)
Imported Upstream version 8.0.7
Diffstat (limited to 'lisp/ob-exp.el')
-rw-r--r--lisp/ob-exp.el260
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