Merge branch 'maint'
[org-mode.git] / lisp / ob-eval.el
blob324cf5fb27c4073efecf2ae349aa0434ab278cbf
1 ;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
5 ;; Author: Eric Schulte
6 ;; Keywords: literate programming, reproducible research, comint
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; These functions build existing Emacs support for executing external
27 ;; shell commands.
29 ;;; Code:
30 (require 'org-macs)
32 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
33 (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
35 (defun org-babel-eval-error-notify (exit-code stderr)
36 "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
37 (let ((buf (get-buffer-create org-babel-error-buffer-name)))
38 (with-current-buffer buf
39 (goto-char (point-max))
40 (save-excursion (insert stderr)))
41 (display-buffer buf))
42 (message "Babel evaluation exited with code %S" exit-code))
44 (defun org-babel-eval (cmd body)
45 "Run CMD on BODY.
46 If CMD succeeds then return its results, otherwise display
47 STDERR with `org-babel-eval-error-notify'."
48 (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
49 (with-current-buffer err-buff (erase-buffer))
50 (with-temp-buffer
51 (insert body)
52 (setq exit-code
53 (org-babel--shell-command-on-region
54 (point-min) (point-max) cmd err-buff))
55 (if (or (not (numberp exit-code)) (> exit-code 0))
56 (progn
57 (with-current-buffer err-buff
58 (org-babel-eval-error-notify exit-code (buffer-string)))
59 (save-excursion
60 (when (get-buffer org-babel-error-buffer-name)
61 (with-current-buffer org-babel-error-buffer-name
62 (unless (derived-mode-p 'compilation-mode)
63 (compilation-mode))
64 ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
65 (setq buffer-read-only nil))))
66 nil)
67 (buffer-string)))))
69 (defun org-babel-eval-read-file (file)
70 "Return the contents of FILE as a string."
71 (with-temp-buffer (insert-file-contents file)
72 (buffer-string)))
74 (defun org-babel--shell-command-on-region (start end command error-buffer)
75 "Execute COMMAND in an inferior shell with region as input.
77 Stripped down version of shell-command-on-region for internal use
78 in Babel only. This lets us work around errors in the original
79 function in various versions of Emacs.
81 (let ((input-file (org-babel-temp-file "ob-input-"))
82 (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
83 ;; Unfortunately, `executable-find' does not support file name
84 ;; handlers. Therefore, we could use it in the local case
85 ;; only.
86 (shell-file-name
87 (cond ((and (not (file-remote-p default-directory))
88 (executable-find shell-file-name))
89 shell-file-name)
90 ((file-executable-p
91 (concat (file-remote-p default-directory) shell-file-name))
92 shell-file-name)
93 ("/bin/sh")))
94 exit-status)
95 ;; There is an error in `process-file' when `error-file' exists.
96 ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
97 ;; workaround for now.
98 (unless (file-remote-p default-directory)
99 (delete-file error-file))
100 ;; we always call this with 'replace, remove conditional
101 ;; Replace specified region with output from command.
102 (let ((swap (< start end)))
103 (goto-char start)
104 (push-mark (point) 'nomsg)
105 (write-region start end input-file)
106 (delete-region start end)
107 (setq exit-status
108 (process-file shell-file-name input-file
109 (if error-file
110 (list t error-file)
112 nil shell-command-switch command))
113 (when swap (exchange-point-and-mark)))
115 (when (and input-file (file-exists-p input-file)
116 ;; bind org-babel--debug-input around the call to keep
117 ;; the temporary input files available for inspection
118 (not (when (boundp 'org-babel--debug-input)
119 org-babel--debug-input)))
120 (delete-file input-file))
122 (when (and error-file (file-exists-p error-file))
123 (when (< 0 (nth 7 (file-attributes error-file)))
124 (with-current-buffer (get-buffer-create error-buffer)
125 (let ((pos-from-end (- (point-max) (point))))
126 (or (bobp)
127 (insert "\f\n"))
128 ;; Do no formatting while reading error file,
129 ;; because that can run a shell command, and we
130 ;; don't want that to cause an infinite recursion.
131 (format-insert-file error-file nil)
132 ;; Put point after the inserted errors.
133 (goto-char (- (point-max) pos-from-end)))
134 (current-buffer)))
135 (delete-file error-file))
136 exit-status))
138 (defun org-babel-eval-wipe-error-buffer ()
139 "Delete the contents of the Org code block error buffer.
140 This buffer is named by `org-babel-error-buffer-name'."
141 (when (get-buffer org-babel-error-buffer-name)
142 (with-current-buffer org-babel-error-buffer-name
143 (delete-region (point-min) (point-max)))))
145 (provide 'ob-eval)
149 ;;; ob-eval.el ends here