1;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- 2 3;; Copyright (C) 2009-2021 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. 46If CMD succeeds then return its results, otherwise display 47STDERR 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 77Stripped down version of shell-command-on-region for internal use 78in Babel only. This lets us work around errors in the original 79function 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 (file-attribute-size (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. 140This 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;;; ob-eval.el ends here 148