Commit | Line | Data |
---|---|---|
afe98dfa | 1 | ;;; ob-eval.el --- org-babel functions for external code evaluation |
86fbb8ca | 2 | |
b73f1974 | 3 | ;; Copyright (C) 2009-2012 Free Software Foundation, Inc. |
86fbb8ca CD |
4 | |
5 | ;; Author: Eric Schulte | |
6 | ;; Keywords: literate programming, reproducible research, comint | |
7 | ;; Homepage: http://orgmode.org | |
86fbb8ca CD |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
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. | |
15 | ||
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. | |
20 | ||
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/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; These functions build existing Emacs support for executing external | |
27 | ;; shell commands. | |
28 | ||
29 | ;;; Code: | |
86fbb8ca CD |
30 | (eval-when-compile (require 'cl)) |
31 | ||
acedf35c CD |
32 | (defvar org-babel-error-buffer-name "*Org-Babel Error Output*") |
33 | ||
86fbb8ca CD |
34 | (defun org-babel-eval-error-notify (exit-code stderr) |
35 | "Open a buffer to display STDERR and a message with the value of EXIT-CODE." | |
acedf35c | 36 | (let ((buf (get-buffer-create org-babel-error-buffer-name))) |
86fbb8ca CD |
37 | (with-current-buffer buf |
38 | (goto-char (point-max)) | |
39 | (save-excursion (insert stderr))) | |
40 | (display-buffer buf)) | |
41 | (message "Babel evaluation exited with code %S" exit-code)) | |
42 | ||
43 | (defun org-babel-eval (cmd body) | |
44 | "Run CMD on BODY. | |
afe98dfa | 45 | If CMD succeeds then return its results, otherwise display |
86fbb8ca | 46 | STDERR with `org-babel-eval-error-notify'." |
acedf35c | 47 | (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code) |
86fbb8ca CD |
48 | (with-current-buffer err-buff (erase-buffer)) |
49 | (with-temp-buffer | |
50 | (insert body) | |
51 | (setq exit-code | |
52 | (org-babel-shell-command-on-region | |
53 | (point-min) (point-max) cmd t 'replace err-buff)) | |
54 | (if (or (not (numberp exit-code)) (> exit-code 0)) | |
55 | (progn | |
56 | (with-current-buffer err-buff | |
57 | (org-babel-eval-error-notify exit-code (buffer-string))) | |
58 | nil) | |
59 | (buffer-string))))) | |
60 | ||
61 | (defun org-babel-eval-read-file (file) | |
62 | "Return the contents of FILE as a string." | |
afe98dfa | 63 | (with-temp-buffer (insert-file-contents file) |
86fbb8ca CD |
64 | (buffer-string))) |
65 | ||
66 | (defun org-babel-shell-command-on-region (start end command | |
8223b1d2 BG |
67 | &optional output-buffer replace |
68 | error-buffer display-error-buffer) | |
86fbb8ca CD |
69 | "Execute COMMAND in an inferior shell with region as input. |
70 | ||
71 | Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' | |
72 | ||
73 | Normally display output (if any) in temp buffer `*Shell Command Output*'; | |
74 | Prefix arg means replace the region with it. Return the exit code of | |
75 | COMMAND. | |
76 | ||
77 | To specify a coding system for converting non-ASCII characters in | |
78 | the input and output to the shell command, use | |
79 | \\[universal-coding-system-argument] before this command. By | |
80 | default, the input (from the current buffer) is encoded in the | |
81 | same coding system that will be used to save the file, | |
82 | `buffer-file-coding-system'. If the output is going to replace | |
83 | the region, then it is decoded from that same coding system. | |
84 | ||
85 | The noninteractive arguments are START, END, COMMAND, | |
86 | OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. | |
87 | Noninteractive callers can specify coding systems by binding | |
88 | `coding-system-for-read' and `coding-system-for-write'. | |
89 | ||
90 | If the command generates output, the output may be displayed | |
91 | in the echo area or in a buffer. | |
92 | If the output is short enough to display in the echo area | |
93 | \(determined by the variable `max-mini-window-height' if | |
94 | `resize-mini-windows' is non-nil), it is shown there. Otherwise | |
95 | it is displayed in the buffer `*Shell Command Output*'. The output | |
96 | is available in that buffer in both cases. | |
97 | ||
98 | If there is output and an error, a message about the error | |
99 | appears at the end of the output. | |
100 | ||
101 | If there is no output, or if output is inserted in the current buffer, | |
102 | then `*Shell Command Output*' is deleted. | |
103 | ||
104 | If the optional fourth argument OUTPUT-BUFFER is non-nil, | |
105 | that says to put the output in some other buffer. | |
106 | If OUTPUT-BUFFER is a buffer or buffer name, put the output there. | |
107 | If OUTPUT-BUFFER is not a buffer and not nil, | |
108 | insert output in the current buffer. | |
109 | In either case, the output is inserted after point (leaving mark after it). | |
110 | ||
111 | If REPLACE, the optional fifth argument, is non-nil, that means insert | |
112 | the output in place of text from START to END, putting point and mark | |
113 | around it. | |
114 | ||
115 | If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer | |
116 | or buffer name to which to direct the command's standard error output. | |
117 | If it is nil, error output is mingled with regular output. | |
118 | If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there | |
119 | were any errors. (This is always t, interactively.) | |
120 | In an interactive call, the variable `shell-command-default-error-buffer' | |
121 | specifies the value of ERROR-BUFFER." | |
122 | (interactive (let (string) | |
123 | (unless (mark) | |
124 | (error "The mark is not set now, so there is no region")) | |
125 | ;; Do this before calling region-beginning | |
126 | ;; and region-end, in case subprocess output | |
127 | ;; relocates them while we are in the minibuffer. | |
128 | (setq string (read-shell-command "Shell command on region: ")) | |
129 | ;; call-interactively recognizes region-beginning and | |
130 | ;; region-end specially, leaving them in the history. | |
131 | (list (region-beginning) (region-end) | |
132 | string | |
133 | current-prefix-arg | |
134 | current-prefix-arg | |
135 | shell-command-default-error-buffer | |
136 | t))) | |
137 | (let ((error-file | |
138 | (if error-buffer | |
139 | (make-temp-file | |
140 | (expand-file-name "scor" | |
acedf35c CD |
141 | (if (featurep 'xemacs) |
142 | (temp-directory) | |
143 | temporary-file-directory))) | |
86fbb8ca CD |
144 | nil)) |
145 | exit-status) | |
146 | (if (or replace | |
147 | (and output-buffer | |
148 | (not (or (bufferp output-buffer) (stringp output-buffer))))) | |
149 | ;; Replace specified region with output from command. | |
150 | (let ((swap (and replace (< start end)))) | |
151 | ;; Don't muck with mark unless REPLACE says we should. | |
152 | (goto-char start) | |
153 | (and replace (push-mark (point) 'nomsg)) | |
154 | (setq exit-status | |
155 | (call-process-region start end shell-file-name t | |
156 | (if error-file | |
157 | (list output-buffer error-file) | |
158 | t) | |
159 | nil shell-command-switch command)) | |
160 | ;; It is rude to delete a buffer which the command is not using. | |
161 | ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) | |
162 | ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) | |
163 | ;; (kill-buffer shell-buffer))) | |
164 | ;; Don't muck with mark unless REPLACE says we should. | |
165 | (and replace swap (exchange-point-and-mark))) | |
166 | ;; No prefix argument: put the output in a temp buffer, | |
167 | ;; replacing its entire contents. | |
168 | (let ((buffer (get-buffer-create | |
169 | (or output-buffer "*Shell Command Output*")))) | |
170 | (unwind-protect | |
171 | (if (eq buffer (current-buffer)) | |
172 | ;; If the input is the same buffer as the output, | |
173 | ;; delete everything but the specified region, | |
174 | ;; then replace that region with the output. | |
175 | (progn (setq buffer-read-only nil) | |
176 | (delete-region (max start end) (point-max)) | |
177 | (delete-region (point-min) (min start end)) | |
178 | (setq exit-status | |
179 | (call-process-region (point-min) (point-max) | |
180 | shell-file-name t | |
181 | (if error-file | |
182 | (list t error-file) | |
183 | t) | |
184 | nil shell-command-switch | |
185 | command))) | |
186 | ;; Clear the output buffer, then run the command with | |
187 | ;; output there. | |
188 | (let ((directory default-directory)) | |
189 | (with-current-buffer buffer | |
190 | (setq buffer-read-only nil) | |
191 | (if (not output-buffer) | |
192 | (setq default-directory directory)) | |
193 | (erase-buffer))) | |
194 | (setq exit-status | |
195 | (call-process-region start end shell-file-name nil | |
196 | (if error-file | |
197 | (list buffer error-file) | |
198 | buffer) | |
199 | nil shell-command-switch command))) | |
200 | ;; Report the output. | |
201 | (with-current-buffer buffer | |
202 | (setq mode-line-process | |
203 | (cond ((null exit-status) | |
204 | " - Error") | |
205 | ((stringp exit-status) | |
206 | (format " - Signal [%s]" exit-status)) | |
207 | ((not (equal 0 exit-status)) | |
208 | (format " - Exit [%d]" exit-status))))) | |
209 | (if (with-current-buffer buffer (> (point-max) (point-min))) | |
210 | ;; There's some output, display it | |
211 | (display-message-or-buffer buffer) | |
212 | ;; No output; error? | |
213 | (let ((output | |
214 | (if (and error-file | |
215 | (< 0 (nth 7 (file-attributes error-file)))) | |
216 | "some error output" | |
217 | "no output"))) | |
218 | (cond ((null exit-status) | |
219 | (message "(Shell command failed with error)")) | |
220 | ((equal 0 exit-status) | |
221 | (message "(Shell command succeeded with %s)" | |
222 | output)) | |
223 | ((stringp exit-status) | |
224 | (message "(Shell command killed by signal %s)" | |
225 | exit-status)) | |
226 | (t | |
227 | (message "(Shell command failed with code %d and %s)" | |
228 | exit-status output)))) | |
229 | ;; Don't kill: there might be useful info in the undo-log. | |
230 | ;; (kill-buffer buffer) | |
231 | )))) | |
232 | ||
233 | (when (and error-file (file-exists-p error-file)) | |
234 | (if (< 0 (nth 7 (file-attributes error-file))) | |
235 | (with-current-buffer (get-buffer-create error-buffer) | |
236 | (let ((pos-from-end (- (point-max) (point)))) | |
237 | (or (bobp) | |
238 | (insert "\f\n")) | |
239 | ;; Do no formatting while reading error file, | |
240 | ;; because that can run a shell command, and we | |
241 | ;; don't want that to cause an infinite recursion. | |
242 | (format-insert-file error-file nil) | |
243 | ;; Put point after the inserted errors. | |
244 | (goto-char (- (point-max) pos-from-end))) | |
245 | (and display-error-buffer | |
246 | (display-buffer (current-buffer))))) | |
247 | (delete-file error-file)) | |
248 | exit-status)) | |
249 | ||
acedf35c CD |
250 | (defun org-babel-eval-wipe-error-buffer () |
251 | "Delete the contents of the Org code block error buffer. | |
252 | This buffer is named by `org-babel-error-buffer-name'." | |
253 | (when (get-buffer org-babel-error-buffer-name) | |
254 | (with-current-buffer org-babel-error-buffer-name | |
255 | (delete-region (point-min) (point-max))))) | |
256 | ||
86fbb8ca CD |
257 | (provide 'ob-eval) |
258 | ||
5b409b39 | 259 | |
86fbb8ca | 260 | |
afe98dfa | 261 | ;;; ob-eval.el ends here |