lisp/org/ob-eval.el

   1 ;;; ob-eval.el --- org-babel functions for external code evaluation
   2
   3 ;; Copyright (C) 2009-2013 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 (eval-when-compile (require 'cl))
  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 t 'replace 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             nil)
  60         (buffer-string)))))
  61
  62 (defun org-babel-eval-read-file (file)
  63   "Return the contents of FILE as a string."
  64   (with-temp-buffer (insert-file-contents file)
  65                     (buffer-string)))
  66
  67 (defun org-babel-shell-command-on-region (start end command
  68                                                 &optional output-buffer replace
  69                                                 error-buffer display-error-buffer)
  70   "Execute COMMAND in an inferior shell with region as input.
  71
  72 Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
  73
  74 Normally display output (if any) in temp buffer `*Shell Command Output*';
  75 Prefix arg means replace the region with it.  Return the exit code of
  76 COMMAND.
  77
  78 To specify a coding system for converting non-ASCII characters in
  79 the input and output to the shell command, use
  80 \\[universal-coding-system-argument] before this command.  By
  81 default, the input (from the current buffer) is encoded in the
  82 same coding system that will be used to save the file,
  83 `buffer-file-coding-system'.  If the output is going to replace
  84 the region, then it is decoded from that same coding system.
  85
  86 The noninteractive arguments are START, END, COMMAND,
  87 OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
  88 Noninteractive callers can specify coding systems by binding
  89 `coding-system-for-read' and `coding-system-for-write'.
  90
  91 If the command generates output, the output may be displayed
  92 in the echo area or in a buffer.
  93 If the output is short enough to display in the echo area
  94 \(determined by the variable `max-mini-window-height' if
  95 `resize-mini-windows' is non-nil), it is shown there.  Otherwise
  96 it is displayed in the buffer `*Shell Command Output*'.  The output
  97 is available in that buffer in both cases.
  98
  99 If there is output and an error, a message about the error
 100 appears at the end of the output.
 101
 102 If there is no output, or if output is inserted in the current buffer,
 103 then `*Shell Command Output*' is deleted.
 104
 105 If the optional fourth argument OUTPUT-BUFFER is non-nil,
 106 that says to put the output in some other buffer.
 107 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
 108 If OUTPUT-BUFFER is not a buffer and not nil,
 109 insert output in the current buffer.
 110 In either case, the output is inserted after point (leaving mark after it).
 111
 112 If REPLACE, the optional fifth argument, is non-nil, that means insert
 113 the output in place of text from START to END, putting point and mark
 114 around it.
 115
 116 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
 117 or buffer name to which to direct the command's standard error output.
 118 If it is nil, error output is mingled with regular output.
 119 If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
 120 were any errors.  (This is always t, interactively.)
 121 In an interactive call, the variable `shell-command-default-error-buffer'
 122 specifies the value of ERROR-BUFFER."
 123   (interactive (let (string)
 124                  (unless (mark)
 125                    (error "The mark is not set now, so there is no region"))
 126                  ;; Do this before calling region-beginning
 127                  ;; and region-end, in case subprocess output
 128                  ;; relocates them while we are in the minibuffer.
 129                  (setq string (read-shell-command "Shell command on region: "))
 130                  ;; call-interactively recognizes region-beginning and
 131                  ;; region-end specially, leaving them in the history.
 132                  (list (region-beginning) (region-end)
 133                        string
 134                        current-prefix-arg
 135                        current-prefix-arg
 136                        shell-command-default-error-buffer
 137                        t)))
 138   (let ((input-file (org-babel-temp-file "input-"))
 139         (error-file (if error-buffer (org-babel-temp-file "scor-") nil))
 140         ;; Unfortunately, `executable-find' does not support file name
 141         ;; handlers.  Therefore, we could use it in the local case
 142         ;; only.
 143         (shell-file-name
 144          (cond ((and (not (file-remote-p default-directory))
 145                      (executable-find shell-file-name))
 146                 shell-file-name)
 147                ((file-executable-p
 148                  (concat (file-remote-p default-directory) shell-file-name))
 149                 shell-file-name)
 150                ("/bin/sh")))
 151         exit-status)
 152     ;; There is an error in `process-file' when `error-file' exists.
 153     ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this
 154     ;; workaround for now.
 155     (unless (file-remote-p default-directory)
 156       (delete-file error-file))
 157     (if (or replace
 158             (and output-buffer
 159                  (not (or (bufferp output-buffer) (stringp output-buffer)))))
 160         ;; Replace specified region with output from command.
 161         (let ((swap (and replace (< start end))))
 162           ;; Don't muck with mark unless REPLACE says we should.
 163           (goto-char start)
 164           (and replace (push-mark (point) 'nomsg))
 165           (write-region start end input-file)
 166           (delete-region start end)
 167           (setq exit-status
 168                 (process-file shell-file-name input-file
 169                               (if error-file
 170                                   (list output-buffer error-file)
 171                                 t)
 172                               nil shell-command-switch command))
 173           ;; It is rude to delete a buffer which the command is not using.
 174           ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
 175           ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
 176           ;;     (kill-buffer shell-buffer)))
 177           ;; Don't muck with mark unless REPLACE says we should.
 178           (and replace swap (exchange-point-and-mark)))
 179       ;; No prefix argument: put the output in a temp buffer,
 180       ;; replacing its entire contents.
 181       (let ((buffer (get-buffer-create
 182                      (or output-buffer "*Shell Command Output*"))))
 183         (unwind-protect
 184             (if (eq buffer (current-buffer))
 185                 ;; If the input is the same buffer as the output,
 186                 ;; delete everything but the specified region,
 187                 ;; then replace that region with the output.
 188                 (progn (setq buffer-read-only nil)
 189                        (delete-region (max start end) (point-max))
 190                        (delete-region (point-min) (min start end))
 191                        (write-region (point-min) (point-max) input-file)
 192                        (delete-region (point-min) (point-max))
 193                        (setq exit-status
 194                              (process-file shell-file-name input-file
 195                                            (if error-file
 196                                                (list t error-file)
 197                                              t)
 198                                            nil shell-command-switch command)))
 199               ;; Clear the output buffer, then run the command with
 200               ;; output there.
 201               (let ((directory default-directory))
 202                 (with-current-buffer buffer
 203                   (setq buffer-read-only nil)
 204                   (if (not output-buffer)
 205                       (setq default-directory directory))
 206                   (erase-buffer)))
 207               (setq exit-status
 208                     (process-file shell-file-name nil
 209                                   (if error-file
 210                                       (list buffer error-file)
 211                                     buffer)
 212                                   nil shell-command-switch command)))
 213           ;; Report the output.
 214           (with-current-buffer buffer
 215             (setq mode-line-process
 216                   (cond ((null exit-status)
 217                          " - Error")
 218                         ((stringp exit-status)
 219                          (format " - Signal [%s]" exit-status))
 220                         ((not (equal 0 exit-status))
 221                          (format " - Exit [%d]" exit-status)))))
 222           (if (with-current-buffer buffer (> (point-max) (point-min)))
 223               ;; There's some output, display it
 224               (display-message-or-buffer buffer)
 225             ;; No output; error?
 226             (let ((output
 227                    (if (and error-file
 228                             (< 0 (nth 7 (file-attributes error-file))))
 229                        "some error output"
 230                      "no output")))
 231               (cond ((null exit-status)
 232                      (message "(Shell command failed with error)"))
 233                     ((equal 0 exit-status)
 234                      (message "(Shell command succeeded with %s)"
 235                               output))
 236                     ((stringp exit-status)
 237                      (message "(Shell command killed by signal %s)"
 238                               exit-status))
 239                     (t
 240                      (message "(Shell command failed with code %d and %s)"
 241                               exit-status output))))
 242             ;; Don't kill: there might be useful info in the undo-log.
 243             ;; (kill-buffer buffer)
 244             ))))
 245
 246     (when (and input-file (file-exists-p input-file))
 247       (delete-file input-file))
 248
 249     (when (and error-file (file-exists-p error-file))
 250       (if (< 0 (nth 7 (file-attributes error-file)))
 251           (with-current-buffer (get-buffer-create error-buffer)
 252             (let ((pos-from-end (- (point-max) (point))))
 253               (or (bobp)
 254                   (insert "\f\n"))
 255               ;; Do no formatting while reading error file,
 256               ;; because that can run a shell command, and we
 257               ;; don't want that to cause an infinite recursion.
 258               (format-insert-file error-file nil)
 259               ;; Put point after the inserted errors.
 260               (goto-char (- (point-max) pos-from-end)))
 261             (and display-error-buffer
 262                  (display-buffer (current-buffer)))))
 263       (delete-file error-file))
 264     exit-status))
 265
 266 (defun org-babel-eval-wipe-error-buffer ()
 267   "Delete the contents of the Org code block error buffer.
 268 This buffer is named by `org-babel-error-buffer-name'."
 269   (when (get-buffer org-babel-error-buffer-name)
 270     (with-current-buffer org-babel-error-buffer-name
 271       (delete-region (point-min) (point-max)))))
 272
 273 (provide 'ob-eval)
 274
 275
 276
 277 ;;; ob-eval.el ends here