[bpt/emacs.git] / lisp / org / ob-eval.el

;;; ob-eval.el --- org-babel functions for external code evaluation

;; Copyright (C) 2009, 2010  Free Software Foundation, Inc.

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

;; 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))

(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")

(defun org-babel-eval-error-notify (exit-code stderr)
  "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
  (let ((buf (get-buffer-create org-babel-error-buffer-name)))
    (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.
If CMD succeeds then return its results, otherwise display
STDERR with `org-babel-eval-error-notify'."
  (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
    (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."
  (with-temp-buffer (insert-file-contents file)
		    (buffer-string)))

(defun org-babel-shell-command-on-region (start end command
				      &optional output-buffer replace
				      error-buffer display-error-buffer)
  "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)))
  (let ((error-file
	 (if error-buffer
	     (make-temp-file
	      (expand-file-name "scor"
                                (if (featurep 'xemacs)
                                    (temp-directory)
                                  temporary-file-directory)))
	   nil))
	exit-status)
    (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))
	  (setq exit-status
		(call-process-region start end shell-file-name t
				     (if error-file
					 (list output-buffer error-file)
				       t)
				     nil shell-command-switch command))
	  ;; 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))
		       (setq exit-status
			     (call-process-region (point-min) (point-max)
						  shell-file-name t
						  (if error-file
						      (list t error-file)
						    t)
						  nil shell-command-switch
						  command)))
	      ;; 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
		    (call-process-region start end shell-file-name nil
					 (if error-file
					     (list buffer error-file)
					   buffer)
					 nil shell-command-switch command)))
	  ;; 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)
	    ))))

    (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))

(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)))))

(provide 'ob-eval)


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