| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- |
| C | 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 | |
