mirror of https://github.com/Chizi123/.emacs.d.git

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