lisp/ob-eval.el

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