diff options
Diffstat (limited to 'lisp/ob-eval.el')
| -rw-r--r-- | lisp/ob-eval.el | 261 |
1 files changed, 261 insertions, 0 deletions
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el new file mode 100644 index 0000000..ddad067 --- /dev/null +++ b/lisp/ob-eval.el @@ -0,0 +1,261 @@ +;;; ob-eval.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009-2012 Free Software Foundation, Inc. + +;; 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)) + +(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 |