lisp/ob-exp.el

   1 ;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
   4
   5 ;; Authors: Eric Schulte
   6 ;;      Dan Davison
   7 ;; Keywords: literate programming, reproducible research
   8 ;; Homepage: http://orgmode.org
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Code:
  26 (require 'ob-core)
  27
  28 (declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
  29 (declare-function org-element-at-point "org-element" ())
  30 (declare-function org-element-context "org-element" (&optional element))
  31 (declare-function org-element-property "org-element" (property element))
  32 (declare-function org-element-type "org-element" (element))
  33 (declare-function org-escape-code-in-string "org-src" (s))
  34 (declare-function org-export-copy-buffer "ox" ())
  35 (declare-function org-fill-template "org" (template alist))
  36 (declare-function org-get-indentation "org" (&optional line))
  37 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
  38
  39 (defvar org-src-preserve-indentation)
  40
  41 (defcustom org-export-use-babel t
  42   "Switch controlling code evaluation and header processing during export.
  43 When set to nil no code will be evaluated as part of the export
  44 process and no header arguments will be obeyed.  When set to
  45 `inline-only', only inline code blocks will be executed.  Users
  46 who wish to avoid evaluating code on export should use the header
  47 argument `:eval never-export'."
  48   :group 'org-babel
  49   :version "24.1"
  50   :type '(choice (const :tag "Never" nil)
  51                  (const :tag "Only inline code" inline-only)
  52                  (const :tag "Always" t))
  53   :safe #'null)
  54
  55
  56 (defmacro org-babel-exp--at-source (&rest body)
  57   "Evaluate BODY at the source of the Babel block at point.
  58 Source is located in `org-babel-exp-reference-buffer'.  The value
  59 returned is the value of the last form in BODY.  Assume that
  60 point is at the beginning of the Babel block."
  61   (declare (indent 1) (debug body))
  62   `(let ((source (get-text-property (point) 'org-reference)))
  63      (with-current-buffer org-babel-exp-reference-buffer
  64        (org-with-wide-buffer
  65         (goto-char source)
  66         ,@body))))
  67
  68 (defun org-babel-exp-src-block ()
  69   "Process source block for export.
  70 Depending on the \":export\" header argument, replace the source
  71 code block like this:
  72
  73 both ---- display the code and the results
  74
  75 code ---- the default, display the code inside the block but do
  76           not process
  77
  78 results - just like none only the block is run on export ensuring
  79           that its results are present in the Org mode buffer
  80
  81 none ---- do not display either code or results upon export
  82
  83 Assume point is at block opening line."
  84   (interactive)
  85   (save-excursion
  86     (let* ((info (org-babel-get-src-block-info 'light))
  87            (lang (nth 0 info))
  88            (raw-params (nth 2 info))
  89            hash)
  90       ;; bail if we couldn't get any info from the block
  91       (unless noninteractive
  92         (message "org-babel-exp process %s at position %d..."
  93                  lang
  94                  (line-beginning-position)))
  95       (when info
  96         ;; if we're actually going to need the parameters
  97         (when (member (cdr (assq :exports (nth 2 info))) '("both" "results"))
  98           (let ((lang-headers (intern (concat "org-babel-default-header-args:"
  99                                               lang))))
 100             (org-babel-exp--at-source
 101                 (setf (nth 2 info)
 102                       (org-babel-process-params
 103                        (apply #'org-babel-merge-params
 104                               org-babel-default-header-args
 105                               (and (boundp lang-headers)
 106                                    (symbol-value lang-headers))
 107                               (append (org-babel-params-from-properties lang)
 108                                       (list raw-params)))))))
 109           (setf hash (org-babel-sha1-hash info)))
 110         (org-babel-exp-do-export info 'block hash)))))
 111
 112 (defcustom org-babel-exp-call-line-template
 113   ""
 114   "Template used to export call lines.
 115 This template may be customized to include the call line name
 116 with any export markup.  The template is filled out using
 117 `org-fill-template', and the following %keys may be used.
 118
 119  line --- call line
 120
 121 An example value would be \"\\n: call: %line\" to export the call line
 122 wrapped in a verbatim environment.
 123
 124 Note: the results are inserted separately after the contents of
 125 this template."
 126   :group 'org-babel
 127   :type 'string)
 128
 129 (defun org-babel-exp-process-buffer ()
 130   "Execute all Babel blocks in current buffer."
 131   (interactive)
 132   (when org-export-use-babel
 133     (save-window-excursion
 134       (let ((case-fold-search t)
 135             (regexp (if (eq org-export-use-babel 'inline-only)
 136                         "\\(call\\|src\\)_"
 137                       "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
 138             ;; Get a pristine copy of current buffer so Babel
 139             ;; references are properly resolved and source block
 140             ;; context is preserved.
 141             (org-babel-exp-reference-buffer (org-export-copy-buffer)))
 142         (unwind-protect
 143             (save-excursion
 144               ;; First attach to every source block their original
 145               ;; position, so that they can be retrieved within
 146               ;; `org-babel-exp-reference-buffer', even after heavy
 147               ;; modifications on current buffer.
 148               ;;
 149               ;; False positives are harmless, so we don't check if
 150               ;; we're really at some Babel object.  Moreover,
 151               ;; `line-end-position' ensures that we propertize
 152               ;; a noticeable part of the object, without affecting
 153               ;; multiple objects on the same line.
 154               (goto-char (point-min))
 155               (while (re-search-forward regexp nil t)
 156                 (let ((s (match-beginning 0)))
 157                   (put-text-property s (line-end-position) 'org-reference s)))
 158               ;; Evaluate from top to bottom every Babel block
 159               ;; encountered.
 160               (goto-char (point-min))
 161               (while (re-search-forward regexp nil t)
 162                 (unless (save-match-data (org-in-commented-heading-p))
 163                   (let* ((element (save-match-data (org-element-context)))
 164                          (type (org-element-type element))
 165                          (begin
 166                           (copy-marker (org-element-property :begin element)))
 167                          (end
 168                           (copy-marker
 169                            (save-excursion
 170                              (goto-char (org-element-property :end element))
 171                              (skip-chars-backward " \r\t\n")
 172                              (point)))))
 173                     (pcase type
 174                       (`inline-src-block
 175                        (let* ((info
 176                                (org-babel-get-src-block-info nil element))
 177                               (params (nth 2 info)))
 178                          (setf (nth 1 info)
 179                                (if (and (cdr (assq :noweb params))
 180                                         (string= "yes"
 181                                                  (cdr (assq :noweb params))))
 182                                    (org-babel-expand-noweb-references
 183                                     info org-babel-exp-reference-buffer)
 184                                  (nth 1 info)))
 185                          (goto-char begin)
 186                          (let ((replacement
 187                                 (org-babel-exp-do-export info 'inline)))
 188                            (if (equal replacement "")
 189                                ;; Replacement code is empty: remove
 190                                ;; inline source block, including extra
 191                                ;; white space that might have been
 192                                ;; created when inserting results.
 193                                (delete-region begin
 194                                               (progn (goto-char end)
 195                                                      (skip-chars-forward " \t")
 196                                                      (point)))
 197                              ;; Otherwise: remove inline src block but
 198                              ;; preserve following white spaces.  Then
 199                              ;; insert value.
 200                              (delete-region begin end)
 201                              (insert replacement)))))
 202                       ((or `babel-call `inline-babel-call)
 203                        (org-babel-exp-do-export (org-babel-lob-get-info element)
 204                                                 'lob)
 205                        (let ((rep
 206                               (org-fill-template
 207                                org-babel-exp-call-line-template
 208                                `(("line"  .
 209                                   ,(org-element-property :value element))))))
 210                          ;; If replacement is empty, completely remove
 211                          ;; the object/element, including any extra
 212                          ;; white space that might have been created
 213                          ;; when including results.
 214                          (if (equal rep "")
 215                              (delete-region
 216                               begin
 217                               (progn (goto-char end)
 218                                      (if (not (eq type 'babel-call))
 219                                          (progn (skip-chars-forward " \t")
 220                                                 (point))
 221                                        (skip-chars-forward " \r\t\n")
 222                                        (line-beginning-position))))
 223                            ;; Otherwise, preserve trailing
 224                            ;; spaces/newlines and then, insert
 225                            ;; replacement string.
 226                            (goto-char begin)
 227                            (delete-region begin end)
 228                            (insert rep))))
 229                       (`src-block
 230                        (let ((match-start (copy-marker (match-beginning 0)))
 231                              (ind (org-get-indentation)))
 232                          ;; Take care of matched block: compute
 233                          ;; replacement string.  In particular, a nil
 234                          ;; REPLACEMENT means the block is left as-is
 235                          ;; while an empty string removes the block.
 236                          (let ((replacement
 237                                 (progn (goto-char match-start)
 238                                        (org-babel-exp-src-block))))
 239                            (cond ((not replacement) (goto-char end))
 240                                  ((equal replacement "")
 241                                   (goto-char end)
 242                                   (skip-chars-forward " \r\t\n")
 243                                   (beginning-of-line)
 244                                   (delete-region begin (point)))
 245                                  (t
 246                                   (goto-char match-start)
 247                                   (delete-region (point)
 248                                                  (save-excursion
 249                                                    (goto-char end)
 250                                                    (line-end-position)))
 251                                   (insert replacement)
 252                                   (if (or org-src-preserve-indentation
 253                                           (org-element-property
 254                                            :preserve-indent element))
 255                                       ;; Indent only code block
 256                                       ;; markers.
 257                                       (save-excursion
 258                                         (skip-chars-backward " \r\t\n")
 259                                         (indent-line-to ind)
 260                                         (goto-char match-start)
 261                                         (indent-line-to ind))
 262                                     ;; Indent everything.
 263                                     (indent-rigidly
 264                                      match-start (point) ind)))))
 265                          (set-marker match-start nil))))
 266                     (set-marker begin nil)
 267                     (set-marker end nil)))))
 268           (kill-buffer org-babel-exp-reference-buffer)
 269           (remove-text-properties (point-min) (point-max) '(org-reference)))))))
 270
 271 (defun org-babel-exp-do-export (info type &optional hash)
 272   "Return a string with the exported content of a code block.
 273 The function respects the value of the :exports header argument."
 274   (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info)))))
 275                           (unless (equal "none" session)
 276                             (org-babel-exp-results info type 'silent)))))
 277         (clean (lambda () (if (eq type 'inline)
 278                          (org-babel-remove-inline-result)
 279                        (org-babel-remove-result info)))))
 280     (pcase (or (cdr (assq :exports (nth 2 info))) "code")
 281       ("none" (funcall silently) (funcall clean) "")
 282       ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type))
 283       ("results" (org-babel-exp-results info type nil hash) "")
 284       ("both"
 285        (org-babel-exp-results info type nil hash)
 286        (org-babel-exp-code info type)))))
 287
 288 (defcustom org-babel-exp-code-template
 289   "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
 290   "Template used to export the body of code blocks.
 291 This template may be customized to include additional information
 292 such as the code block name, or the values of particular header
 293 arguments.  The template is filled out using `org-fill-template',
 294 and the following %keys may be used.
 295
 296  lang ------ the language of the code block
 297  name ------ the name of the code block
 298  body ------ the body of the code block
 299  switches -- the switches associated to the code block
 300  flags ----- the flags passed to the code block
 301
 302 In addition to the keys mentioned above, every header argument
 303 defined for the code block may be used as a key and will be
 304 replaced with its value."
 305   :group 'org-babel
 306   :type 'string)
 307
 308 (defcustom org-babel-exp-inline-code-template
 309   "src_%lang[%switches%flags]{%body}"
 310   "Template used to export the body of inline code blocks.
 311 This template may be customized to include additional information
 312 such as the code block name, or the values of particular header
 313 arguments.  The template is filled out using `org-fill-template',
 314 and the following %keys may be used.
 315
 316  lang ------ the language of the code block
 317  name ------ the name of the code block
 318  body ------ the body of the code block
 319  switches -- the switches associated to the code block
 320  flags ----- the flags passed to the code block
 321
 322 In addition to the keys mentioned above, every header argument
 323 defined for the code block may be used as a key and will be
 324 replaced with its value."
 325   :group 'org-babel
 326   :type 'string
 327   :version "25.2"
 328   :package-version '(Org . "8.3"))
 329
 330 (defun org-babel-exp-code (info type)
 331   "Return the original code block formatted for export."
 332   (setf (nth 1 info)
 333         (if (string= "strip-export" (cdr (assq :noweb (nth 2 info))))
 334             (replace-regexp-in-string
 335              (org-babel-noweb-wrap) "" (nth 1 info))
 336           (if (org-babel-noweb-p (nth 2 info) :export)
 337               (org-babel-expand-noweb-references
 338                info org-babel-exp-reference-buffer)
 339             (nth 1 info))))
 340   (org-fill-template
 341    (if (eq type 'inline)
 342        org-babel-exp-inline-code-template
 343        org-babel-exp-code-template)
 344    `(("lang"  . ,(nth 0 info))
 345      ("body"  . ,(org-escape-code-in-string (nth 1 info)))
 346      ("switches" . ,(let ((f (nth 3 info)))
 347                       (and (org-string-nw-p f) (concat " " f))))
 348      ("flags" . ,(let ((f (assq :flags (nth 2 info))))
 349                    (and f (concat " " (cdr f)))))
 350      ,@(mapcar (lambda (pair)
 351                  (cons (substring (symbol-name (car pair)) 1)
 352                        (format "%S" (cdr pair))))
 353                (nth 2 info))
 354      ("name"  . ,(or (nth 4 info) "")))))
 355
 356 (defun org-babel-exp-results (info type &optional silent hash)
 357   "Evaluate and return the results of the current code block for export.
 358 Results are prepared in a manner suitable for export by Org mode.
 359 This function is called by `org-babel-exp-do-export'.  The code
 360 block will be evaluated.  Optional argument SILENT can be used to
 361 inhibit insertion of results into the buffer."
 362   (unless (and hash (equal hash (org-babel-current-result-hash)))
 363     (let ((lang (nth 0 info))
 364           (body (if (org-babel-noweb-p (nth 2 info) :eval)
 365                     (org-babel-expand-noweb-references
 366                      info org-babel-exp-reference-buffer)
 367                   (nth 1 info)))
 368           (info (copy-sequence info))
 369           (org-babel-current-src-block-location (point-marker)))
 370       ;; Skip code blocks which we can't evaluate.
 371       (when (fboundp (intern (concat "org-babel-execute:" lang)))
 372         (org-babel-eval-wipe-error-buffer)
 373         (setf (nth 1 info) body)
 374         (setf (nth 2 info)
 375               (org-babel-exp--at-source
 376                 (org-babel-process-params
 377                  (org-babel-merge-params
 378                   (nth 2 info)
 379                   `((:results . ,(if silent "silent" "replace")))))))
 380         (pcase type
 381           (`block (org-babel-execute-src-block nil info))
 382           (`inline
 383             ;; Position the point on the inline source block
 384             ;; allowing `org-babel-insert-result' to check that the
 385             ;; block is inline.
 386             (goto-char (nth 5 info))
 387             (org-babel-execute-src-block nil info))
 388           (`lob
 389            (save-excursion
 390              (goto-char (nth 5 info))
 391              (let (org-confirm-babel-evaluate)
 392                (org-babel-execute-src-block nil info)))))))))
 393
 394
 395 (provide 'ob-exp)
 396
 397 ;;; ob-exp.el ends here