lisp/ob-eval.el

   1 ;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte
   6 ;; Keywords: literate programming, reproducible research, comint
   7 ;; Homepage: https://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 <https://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
  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             (save-excursion
  60               (when (get-buffer org-babel-error-buffer-name)
  61                 (with-current-buffer org-babel-error-buffer-name
  62                   (unless (derived-mode-p 'compilation-mode)
  63                     (compilation-mode))
  64                   ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
  65                   (setq buffer-read-only nil))))
  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       (when (< 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