lisp/ob-exp.el

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