lisp/ob-eval.el

   1 ;;; ob-eval.el --- org-babel functions for external code evaluation
   2
   3 ;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte
   6 ;; Keywords: literate programming, reproducible research, comint
   7 ;; Homepage: http://orgmode.org
   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:
  30 (eval-when-compile (require 'cl))
  31
  32 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
  33 (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
  34
  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))
  43
  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             nil)
  60         (buffer-string)))))
  61
  62 (defun org-babel-eval-read-file (file)
  63   "Return the contents of FILE as a string."
  64   (with-temp-buffer (insert-file-contents file)
  65                     (buffer-string)))
  66
  67 (defun org-babel--shell-command-on-region (start end command error-buffer)
  68   "Execute COMMAND in an inferior shell with region as input.
  69
  70 Stripped down version of shell-command-on-region for internal use
  71 in Babel only.  This lets us work around errors in the original
  72 function in various versions of Emacs.
  73 "
  74   (let ((input-file (org-babel-temp-file "ob-input-"))
  75         (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
  76         ;; Unfortunately, `executable-find' does not support file name
  77         ;; handlers.  Therefore, we could use it in the local case
  78         ;; only.
  79         (shell-file-name
  80          (cond ((and (not (file-remote-p default-directory))
  81                      (executable-find shell-file-name))
  82                 shell-file-name)
  83                ((file-executable-p
  84                  (concat (file-remote-p default-directory) shell-file-name))
  85                 shell-file-name)
  86                ("/bin/sh")))
  87         exit-status)
  88     ;; There is an error in `process-file' when `error-file' exists.
  89     ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
  90     ;; workaround for now.
  91     (unless (file-remote-p default-directory)
  92       (delete-file error-file))
  93     ;; we always call this with 'replace, remove conditional
  94     ;; Replace specified region with output from command.
  95     (let ((swap (< start end)))
  96       (goto-char start)
  97       (push-mark (point) 'nomsg)
  98       (write-region start end input-file)
  99       (delete-region start end)
 100       (setq exit-status
 101             (process-file shell-file-name input-file
 102                           (if error-file
 103                               (list t error-file)
 104                             t)
 105                           nil shell-command-switch command))
 106       (when swap (exchange-point-and-mark)))
 107
 108     (when (and input-file (file-exists-p input-file)
 109                ;; bind org-babel--debug-input around the call to keep
 110                ;; the temporary input files available for inspection
 111                (not (when (boundp 'org-babel--debug-input)
 112                       org-babel--debug-input)))
 113       (delete-file input-file))
 114
 115     (when (and error-file (file-exists-p error-file))
 116       (if (< 0 (nth 7 (file-attributes error-file)))
 117           (with-current-buffer (get-buffer-create error-buffer)
 118             (let ((pos-from-end (- (point-max) (point))))
 119               (or (bobp)
 120                   (insert "\f\n"))
 121               ;; Do no formatting while reading error file,
 122               ;; because that can run a shell command, and we
 123               ;; don't want that to cause an infinite recursion.
 124               (format-insert-file error-file nil)
 125               ;; Put point after the inserted errors.
 126               (goto-char (- (point-max) pos-from-end)))
 127             (current-buffer)))
 128       (delete-file error-file))
 129     exit-status))
 130
 131 (defun org-babel-eval-wipe-error-buffer ()
 132   "Delete the contents of the Org code block error buffer.
 133 This buffer is named by `org-babel-error-buffer-name'."
 134   (when (get-buffer org-babel-error-buffer-name)
 135     (with-current-buffer org-babel-error-buffer-name
 136       (delete-region (point-min) (point-max)))))
 137
 138 (provide 'ob-eval)
 139
 140
 141
 142 ;;; ob-eval.el ends here