ob-eval.el (6911B)
1 ;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 5 ;; Author: Eric Schulte 6 ;; Keywords: literate programming, reproducible research, comint 7 ;; URL: 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 31 (require 'org-macs) 32 (org-assert-version) 33 34 (eval-when-compile (require 'subr-x)) ; For `string-empty-p', Emacs < 29 35 36 (defvar org-babel-error-buffer-name "*Org-Babel Error Output*") 37 (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) 38 39 (defun org-babel-eval-error-notify (exit-code stderr) 40 "Open a buffer to display STDERR and a message with the value of EXIT-CODE. 41 If EXIT-CODE is nil, display the message without a code." 42 (let ((buf (get-buffer-create org-babel-error-buffer-name))) 43 (with-current-buffer buf 44 (goto-char (point-max)) 45 (save-excursion 46 (unless (bolp) (insert "\n")) 47 (insert stderr) 48 (if exit-code 49 (insert (format "[ Babel evaluation exited with code %S ]" exit-code)) 50 (insert "[ Babel evaluation exited abnormally ]")))) 51 (display-buffer buf)) 52 (if exit-code 53 (message "Babel evaluation exited with code %S" exit-code) 54 (message "Babel evaluation exited abnormally"))) 55 56 (defun org-babel-eval (command query) 57 "Run COMMAND on QUERY. 58 Return standard output produced by COMMAND. If COMMAND exits 59 with a non-zero code or produces error output, show it with 60 `org-babel-eval-error-notify'. 61 62 Writes QUERY into a temp-buffer that is processed with 63 `org-babel--shell-command-on-region'." 64 (let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code) 65 (with-current-buffer error-buffer (erase-buffer)) 66 (with-temp-buffer 67 ;; Ensure trailing newline. It is required for cmdproxy.exe. 68 (insert query "\n") 69 (setq exit-code 70 (org-babel--shell-command-on-region 71 command error-buffer)) 72 (let ((stderr (with-current-buffer error-buffer (buffer-string)))) 73 (if (or (not (numberp exit-code)) 74 (> exit-code 0) 75 (not (string-empty-p stderr))) 76 (progn 77 (org-babel-eval-error-notify exit-code stderr) 78 (save-excursion 79 (when (get-buffer org-babel-error-buffer-name) 80 (with-current-buffer org-babel-error-buffer-name 81 (unless (derived-mode-p 'compilation-mode) 82 (compilation-mode)) 83 ;; Compilation-mode enforces read-only, but 84 ;; Babel expects the buffer modifiable. 85 (setq buffer-read-only nil)))) 86 ;; Return output, if any. 87 (buffer-string)) 88 (buffer-string)))))) 89 90 (defun org-babel-eval-read-file (file) 91 "Return the contents of FILE as a string." 92 (with-temp-buffer (insert-file-contents file) 93 (buffer-string))) 94 95 (defun org-babel--shell-command-on-region (command error-buffer) 96 "Execute COMMAND in an inferior shell with region as input. 97 Stripped down version of `shell-command-on-region' for internal use in 98 Babel only. This lets us work around errors in the original function 99 in various versions of Emacs. This expects the query to be run to be 100 in the current temp buffer. This is written into 101 input-file. ERROR-BUFFER is the name of the file which 102 `org-babel-eval' has created to use for any error messages that are 103 returned." 104 105 (let ((input-file (org-babel-temp-file "ob-input-")) 106 (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil)) 107 (shell-file-name (org-babel--get-shell-file-name)) 108 exit-status) 109 ;; we always call this with 'replace, remove conditional 110 ;; Replace specified region with output from command. 111 (org-babel--write-temp-buffer-input-file input-file) 112 (setq exit-status 113 (process-file shell-file-name input-file 114 (if error-file 115 (list t error-file) 116 t) 117 nil shell-command-switch command)) 118 119 (when (and input-file (file-exists-p input-file) 120 ;; bind org-babel--debug-input around the call to keep 121 ;; the temporary input files available for inspection 122 (not (when (boundp 'org-babel--debug-input) 123 org-babel--debug-input))) 124 (delete-file input-file)) 125 126 (when (and error-file (file-exists-p error-file)) 127 (when (< 0 (file-attribute-size (file-attributes error-file))) 128 (with-current-buffer (get-buffer-create error-buffer) 129 (let ((pos-from-end (- (point-max) (point)))) 130 (or (bobp) 131 (insert "\f\n")) 132 ;; Do no formatting while reading error file, 133 ;; because that can run a shell command, and we 134 ;; don't want that to cause an infinite recursion. 135 (format-insert-file error-file nil) 136 ;; Put point after the inserted errors. 137 (goto-char (- (point-max) pos-from-end))) 138 (current-buffer))) 139 (delete-file error-file)) 140 exit-status)) 141 142 (defun org-babel--write-temp-buffer-input-file (input-file) 143 "Write the contents of the current temp buffer into INPUT-FILE." 144 (let ((start (point-min)) 145 (end (point-max))) 146 (goto-char start) 147 (push-mark (point) 'nomsg) 148 (write-region start end input-file) 149 (delete-region start end) 150 (exchange-point-and-mark))) 151 152 (defun org-babel-eval-wipe-error-buffer () 153 "Delete the contents of the Org code block error buffer. 154 This buffer is named by `org-babel-error-buffer-name'." 155 (when (get-buffer org-babel-error-buffer-name) 156 (with-current-buffer org-babel-error-buffer-name 157 (delete-region (point-min) (point-max))))) 158 159 (defun org-babel--get-shell-file-name () 160 "Return system `shell-file-name', defaulting to /bin/sh. 161 Unfortunately, `executable-find' does not support file name 162 handlers. Therefore, we could use it in the local case only." 163 ;; FIXME: Since Emacs 27, `executable-find' accepts optional second 164 ;; argument supporting remote hosts. 165 (cond ((and (not (file-remote-p default-directory)) 166 (executable-find shell-file-name)) 167 shell-file-name) 168 ((file-executable-p 169 (concat (file-remote-p default-directory) shell-file-name)) 170 shell-file-name) 171 ("/bin/sh"))) 172 173 (provide 'ob-eval) 174 175 ;;; ob-eval.el ends here