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