lisp/ob-eval.el

   1 ;;; ob-eval.el --- org-babel functions for external code evaluation
   2
   3 ;; Copyright (C) 2009-2014 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 (require 'org-macs)
  31 (eval-when-compile (require 'cl))
  32
  33 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
  34 (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
  35
  36 (defun org-babel-eval-error-notify (exit-code stderr)
  37   "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
  38   (let ((buf (get-buffer-create org-babel-error-buffer-name)))
  39     (with-current-buffer buf
  40       (goto-char (point-max))
  41       (save-excursion (insert stderr)))
  42     (display-buffer buf))
  43   (message "Babel evaluation exited with code %S" exit-code))
  44
  45 (defun org-babel-eval (cmd body)
  46   "Run CMD on BODY.
  47 If CMD succeeds then return its results, otherwise display
  48 STDERR with `org-babel-eval-error-notify'."
  49   (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
  50     (with-current-buffer err-buff (erase-buffer))
  51     (with-temp-buffer
  52       (insert body)
  53       (setq exit-code
  54             (org-babel--shell-command-on-region
  55              (point-min) (point-max) cmd err-buff))
  56       (if (or (not (numberp exit-code)) (> exit-code 0))
  57           (progn
  58             (with-current-buffer err-buff
  59               (org-babel-eval-error-notify exit-code (buffer-string)))
  60             (save-excursion
  61               (when (get-buffer org-babel-error-buffer-name)
  62                 (with-current-buffer org-babel-error-buffer-name
  63                   (compilation-mode)
  64                   ;;compilation-mode enforces read-only
  65                   (read-only-mode 0))))
  66             nil)
  67         (buffer-string)))))
  68
  69 (defun org-babel-eval-read-file (file)
  70   "Return the contents of FILE as a string."
  71   (with-temp-buffer (insert-file-contents file)
  72                     (buffer-string)))
  73
  74 (defun org-babel--shell-command-on-region (start end command error-buffer)
  75   "Execute COMMAND in an inferior shell with region as input.
  76
  77 Stripped down version of shell-command-on-region for internal use
  78 in Babel only.  This lets us work around errors in the original
  79 function in various versions of Emacs.
  80 "
  81   (let ((input-file (org-babel-temp-file "ob-input-"))
  82         (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
  83         ;; Unfortunately, `executable-find' does not support file name
  84         ;; handlers.  Therefore, we could use it in the local case
  85         ;; only.
  86         (shell-file-name
  87          (cond ((and (not (file-remote-p default-directory))
  88                      (executable-find shell-file-name))
  89                 shell-file-name)
  90                ((file-executable-p
  91                  (concat (file-remote-p default-directory) shell-file-name))
  92                 shell-file-name)
  93                ("/bin/sh")))
  94         exit-status)
  95     ;; There is an error in `process-file' when `error-file' exists.
  96     ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
  97     ;; workaround for now.
  98     (unless (file-remote-p default-directory)
  99       (delete-file error-file))
 100     ;; we always call this with 'replace, remove conditional
 101     ;; Replace specified region with output from command.
 102     (let ((swap (< start end)))
 103       (goto-char start)
 104       (push-mark (point) 'nomsg)
 105       (write-region start end input-file)
 106       (delete-region start end)
 107       (setq exit-status
 108             (process-file shell-file-name input-file
 109                           (if error-file
 110                               (list t error-file)
 111                             t)
 112                           nil shell-command-switch command))
 113       (when swap (exchange-point-and-mark)))
 114
 115     (when (and input-file (file-exists-p input-file)
 116                ;; bind org-babel--debug-input around the call to keep
 117                ;; the temporary input files available for inspection
 118                (not (when (boundp 'org-babel--debug-input)
 119                       org-babel--debug-input)))
 120       (delete-file input-file))
 121
 122     (when (and error-file (file-exists-p error-file))
 123       (if (< 0 (nth 7 (file-attributes error-file)))
 124           (with-current-buffer (get-buffer-create error-buffer)
 125             (let ((pos-from-end (- (point-max) (point))))
 126               (or (bobp)
 127                   (insert "\f\n"))
 128               ;; Do no formatting while reading error file,
 129               ;; because that can run a shell command, and we
 130               ;; don't want that to cause an infinite recursion.
 131               (format-insert-file error-file nil)
 132               ;; Put point after the inserted errors.
 133               (goto-char (- (point-max) pos-from-end)))
 134             (current-buffer)))
 135       (delete-file error-file))
 136     exit-status))
 137
 138 (defun org-babel-eval-wipe-error-buffer ()
 139   "Delete the contents of the Org code block error buffer.
 140 This buffer is named by `org-babel-error-buffer-name'."
 141   (when (get-buffer org-babel-error-buffer-name)
 142     (with-current-buffer org-babel-error-buffer-name
 143       (delete-region (point-min) (point-max)))))
 144
 145 (provide 'ob-eval)
 146
 147
 148
 149 ;;; ob-eval.el ends here