ob-eval.el 10.5 KB
Newer Older
Carsten Dominik's avatar
Carsten Dominik committed
1
;;; ob-eval.el --- org-babel functions for external code evaluation
2

3
;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: http://orgmode.org

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; These functions build existing Emacs support for executing external
;; shell commands.

;;; Code:
(eval-when-compile (require 'cl))

Carsten Dominik's avatar
Carsten Dominik committed
32
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
33
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
Carsten Dominik's avatar
Carsten Dominik committed
34

35 36
(defun org-babel-eval-error-notify (exit-code stderr)
  "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
Carsten Dominik's avatar
Carsten Dominik committed
37
  (let ((buf (get-buffer-create org-babel-error-buffer-name)))
38 39 40 41 42 43 44 45
    (with-current-buffer buf
      (goto-char (point-max))
      (save-excursion (insert stderr)))
    (display-buffer buf))
  (message "Babel evaluation exited with code %S" exit-code))

(defun org-babel-eval (cmd body)
  "Run CMD on BODY.
Carsten Dominik's avatar
Carsten Dominik committed
46
If CMD succeeds then return its results, otherwise display
47
STDERR with `org-babel-eval-error-notify'."
Carsten Dominik's avatar
Carsten Dominik committed
48
  (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
    (with-current-buffer err-buff (erase-buffer))
    (with-temp-buffer
      (insert body)
      (setq exit-code
	    (org-babel-shell-command-on-region
	     (point-min) (point-max) cmd t 'replace err-buff))
      (if (or (not (numberp exit-code)) (> exit-code 0))
	  (progn
	    (with-current-buffer err-buff
	      (org-babel-eval-error-notify exit-code (buffer-string)))
	    nil)
	(buffer-string)))))

(defun org-babel-eval-read-file (file)
  "Return the contents of FILE as a string."
Carsten Dominik's avatar
Carsten Dominik committed
64
  (with-temp-buffer (insert-file-contents file)
65 66 67
		    (buffer-string)))

(defun org-babel-shell-command-on-region (start end command
68 69
						&optional output-buffer replace
						error-buffer display-error-buffer)
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
  "Execute COMMAND in an inferior shell with region as input.

Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'

Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it.  Return the exit code of
COMMAND.

To specify a coding system for converting non-ASCII characters in
the input and output to the shell command, use
\\[universal-coding-system-argument] before this command.  By
default, the input (from the current buffer) is encoded in the
same coding system that will be used to save the file,
`buffer-file-coding-system'.  If the output is going to replace
the region, then it is decoded from that same coding system.

The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.

If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.  Otherwise
it is displayed in the buffer `*Shell Command Output*'.  The output
is available in that buffer in both cases.

If there is output and an error, a message about the error
appears at the end of the output.

If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.

If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).

If REPLACE, the optional fifth argument, is non-nil, that means insert
the output in place of text from START to END, putting point and mark
around it.

If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors.  (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
  (interactive (let (string)
		 (unless (mark)
		   (error "The mark is not set now, so there is no region"))
		 ;; Do this before calling region-beginning
		 ;; and region-end, in case subprocess output
		 ;; relocates them while we are in the minibuffer.
		 (setq string (read-shell-command "Shell command on region: "))
		 ;; call-interactively recognizes region-beginning and
		 ;; region-end specially, leaving them in the history.
		 (list (region-beginning) (region-end)
		       string
		       current-prefix-arg
		       current-prefix-arg
		       shell-command-default-error-buffer
		       t)))
138 139
  (let ((input-file (org-babel-temp-file "input-"))
	(error-file (if error-buffer (org-babel-temp-file "scor-") nil))
140 141 142
	;; Unfortunately, `executable-find' does not support file name
	;; handlers.  Therefore, we could use it in the local case
	;; only.
143
	(shell-file-name
144 145 146 147 148 149 150
	 (cond ((and (not (file-remote-p default-directory))
		     (executable-find shell-file-name))
		shell-file-name)
	       ((file-executable-p
		 (concat (file-remote-p default-directory) shell-file-name))
		shell-file-name)
	       ("/bin/sh")))
151
	exit-status)
152 153 154 155 156
    ;; There is an error in `process-file' when `error-file' exists.
    ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
    ;; workaround for now.
    (unless (file-remote-p default-directory)
      (delete-file error-file))
157 158 159 160 161 162 163 164
    (if (or replace
	    (and output-buffer
		 (not (or (bufferp output-buffer) (stringp output-buffer)))))
	;; Replace specified region with output from command.
	(let ((swap (and replace (< start end))))
	  ;; Don't muck with mark unless REPLACE says we should.
	  (goto-char start)
	  (and replace (push-mark (point) 'nomsg))
165 166
	  (write-region start end input-file)
	  (delete-region start end)
167
	  (setq exit-status
168 169 170 171 172
		(process-file shell-file-name input-file
			      (if error-file
				  (list output-buffer error-file)
				t)
			      nil shell-command-switch command))
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
	  ;; It is rude to delete a buffer which the command is not using.
	  ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
	  ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
	  ;; 	 (kill-buffer shell-buffer)))
	  ;; Don't muck with mark unless REPLACE says we should.
	  (and replace swap (exchange-point-and-mark)))
      ;; No prefix argument: put the output in a temp buffer,
      ;; replacing its entire contents.
      (let ((buffer (get-buffer-create
		     (or output-buffer "*Shell Command Output*"))))
	(unwind-protect
	    (if (eq buffer (current-buffer))
		;; If the input is the same buffer as the output,
		;; delete everything but the specified region,
		;; then replace that region with the output.
		(progn (setq buffer-read-only nil)
		       (delete-region (max start end) (point-max))
		       (delete-region (point-min) (min start end))
191 192
		       (write-region (point-min) (point-max) input-file)
		       (delete-region (point-min) (point-max))
193
		       (setq exit-status
194 195 196 197 198
			     (process-file shell-file-name input-file
					   (if error-file
					       (list t error-file)
					     t)
					   nil shell-command-switch command)))
199 200 201 202 203 204 205 206 207
	      ;; Clear the output buffer, then run the command with
	      ;; output there.
	      (let ((directory default-directory))
		(with-current-buffer buffer
		  (setq buffer-read-only nil)
		  (if (not output-buffer)
		      (setq default-directory directory))
		  (erase-buffer)))
	      (setq exit-status
208 209 210 211 212
		    (process-file shell-file-name nil
				  (if error-file
				      (list buffer error-file)
				    buffer)
				  nil shell-command-switch command)))
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
	  ;; Report the output.
	  (with-current-buffer buffer
	    (setq mode-line-process
		  (cond ((null exit-status)
			 " - Error")
			((stringp exit-status)
			 (format " - Signal [%s]" exit-status))
			((not (equal 0 exit-status))
			 (format " - Exit [%d]" exit-status)))))
	  (if (with-current-buffer buffer (> (point-max) (point-min)))
	      ;; There's some output, display it
	      (display-message-or-buffer buffer)
	    ;; No output; error?
	    (let ((output
		   (if (and error-file
			    (< 0 (nth 7 (file-attributes error-file))))
		       "some error output"
		     "no output")))
	      (cond ((null exit-status)
		     (message "(Shell command failed with error)"))
		    ((equal 0 exit-status)
		     (message "(Shell command succeeded with %s)"
			      output))
		    ((stringp exit-status)
		     (message "(Shell command killed by signal %s)"
			      exit-status))
		    (t
		     (message "(Shell command failed with code %d and %s)"
			      exit-status output))))
	    ;; Don't kill: there might be useful info in the undo-log.
	    ;; (kill-buffer buffer)
	    ))))

246 247 248
    (when (and input-file (file-exists-p input-file))
      (delete-file input-file))

249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
    (when (and error-file (file-exists-p error-file))
      (if (< 0 (nth 7 (file-attributes error-file)))
	  (with-current-buffer (get-buffer-create error-buffer)
	    (let ((pos-from-end (- (point-max) (point))))
	      (or (bobp)
		  (insert "\f\n"))
	      ;; Do no formatting while reading error file,
	      ;; because that can run a shell command, and we
	      ;; don't want that to cause an infinite recursion.
	      (format-insert-file error-file nil)
	      ;; Put point after the inserted errors.
	      (goto-char (- (point-max) pos-from-end)))
	    (and display-error-buffer
		 (display-buffer (current-buffer)))))
      (delete-file error-file))
    exit-status))

Carsten Dominik's avatar
Carsten Dominik committed
266 267 268 269 270 271 272
(defun org-babel-eval-wipe-error-buffer ()
  "Delete the contents of the Org code block error buffer.
This buffer is named by `org-babel-error-buffer-name'."
  (when (get-buffer org-babel-error-buffer-name)
    (with-current-buffer org-babel-error-buffer-name
      (delete-region (point-min) (point-max)))))

273 274
(provide 'ob-eval)

275

276

Carsten Dominik's avatar
Carsten Dominik committed
277
;;; ob-eval.el ends here