lisp/ob-exp.el

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