ob-eval.el 9.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263
  1. ;;; ob-eval.el --- org-babel functions for external code evaluation
  2. ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research, comint
  5. ;; Homepage: http://orgmode.org
  6. ;; Version: 7.5
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; These functions build existing Emacs support for executing external
  20. ;; shell commands.
  21. ;;; Code:
  22. (eval-when-compile (require 'cl))
  23. (defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
  24. (defun org-babel-eval-error-notify (exit-code stderr)
  25. "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
  26. (let ((buf (get-buffer-create org-babel-error-buffer-name)))
  27. (with-current-buffer buf
  28. (goto-char (point-max))
  29. (save-excursion (insert stderr)))
  30. (display-buffer buf))
  31. (message "Babel evaluation exited with code %S" exit-code))
  32. (defun org-babel-eval (cmd body)
  33. "Run CMD on BODY.
  34. If CMD succeeds then return its results, otherwise display
  35. STDERR with `org-babel-eval-error-notify'."
  36. (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
  37. (with-current-buffer err-buff (erase-buffer))
  38. (with-temp-buffer
  39. (insert body)
  40. (setq exit-code
  41. (org-babel-shell-command-on-region
  42. (point-min) (point-max) cmd t 'replace err-buff))
  43. (if (or (not (numberp exit-code)) (> exit-code 0))
  44. (progn
  45. (with-current-buffer err-buff
  46. (org-babel-eval-error-notify exit-code (buffer-string)))
  47. nil)
  48. (buffer-string)))))
  49. (defun org-babel-eval-read-file (file)
  50. "Return the contents of FILE as a string."
  51. (with-temp-buffer (insert-file-contents file)
  52. (buffer-string)))
  53. (defun org-babel-shell-command-on-region (start end command
  54. &optional output-buffer replace
  55. error-buffer display-error-buffer)
  56. "Execute COMMAND in an inferior shell with region as input.
  57. Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
  58. Normally display output (if any) in temp buffer `*Shell Command Output*';
  59. Prefix arg means replace the region with it. Return the exit code of
  60. COMMAND.
  61. To specify a coding system for converting non-ASCII characters in
  62. the input and output to the shell command, use
  63. \\[universal-coding-system-argument] before this command. By
  64. default, the input (from the current buffer) is encoded in the
  65. same coding system that will be used to save the file,
  66. `buffer-file-coding-system'. If the output is going to replace
  67. the region, then it is decoded from that same coding system.
  68. The noninteractive arguments are START, END, COMMAND,
  69. OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
  70. Noninteractive callers can specify coding systems by binding
  71. `coding-system-for-read' and `coding-system-for-write'.
  72. If the command generates output, the output may be displayed
  73. in the echo area or in a buffer.
  74. If the output is short enough to display in the echo area
  75. \(determined by the variable `max-mini-window-height' if
  76. `resize-mini-windows' is non-nil), it is shown there. Otherwise
  77. it is displayed in the buffer `*Shell Command Output*'. The output
  78. is available in that buffer in both cases.
  79. If there is output and an error, a message about the error
  80. appears at the end of the output.
  81. If there is no output, or if output is inserted in the current buffer,
  82. then `*Shell Command Output*' is deleted.
  83. If the optional fourth argument OUTPUT-BUFFER is non-nil,
  84. that says to put the output in some other buffer.
  85. If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
  86. If OUTPUT-BUFFER is not a buffer and not nil,
  87. insert output in the current buffer.
  88. In either case, the output is inserted after point (leaving mark after it).
  89. If REPLACE, the optional fifth argument, is non-nil, that means insert
  90. the output in place of text from START to END, putting point and mark
  91. around it.
  92. If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
  93. or buffer name to which to direct the command's standard error output.
  94. If it is nil, error output is mingled with regular output.
  95. If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
  96. were any errors. (This is always t, interactively.)
  97. In an interactive call, the variable `shell-command-default-error-buffer'
  98. specifies the value of ERROR-BUFFER."
  99. (interactive (let (string)
  100. (unless (mark)
  101. (error "The mark is not set now, so there is no region"))
  102. ;; Do this before calling region-beginning
  103. ;; and region-end, in case subprocess output
  104. ;; relocates them while we are in the minibuffer.
  105. (setq string (read-shell-command "Shell command on region: "))
  106. ;; call-interactively recognizes region-beginning and
  107. ;; region-end specially, leaving them in the history.
  108. (list (region-beginning) (region-end)
  109. string
  110. current-prefix-arg
  111. current-prefix-arg
  112. shell-command-default-error-buffer
  113. t)))
  114. (let ((error-file
  115. (if error-buffer
  116. (make-temp-file
  117. (expand-file-name "scor"
  118. (if (featurep 'xemacs)
  119. (temp-directory)
  120. temporary-file-directory)))
  121. nil))
  122. exit-status)
  123. (if (or replace
  124. (and output-buffer
  125. (not (or (bufferp output-buffer) (stringp output-buffer)))))
  126. ;; Replace specified region with output from command.
  127. (let ((swap (and replace (< start end))))
  128. ;; Don't muck with mark unless REPLACE says we should.
  129. (goto-char start)
  130. (and replace (push-mark (point) 'nomsg))
  131. (setq exit-status
  132. (call-process-region start end shell-file-name t
  133. (if error-file
  134. (list output-buffer error-file)
  135. t)
  136. nil shell-command-switch command))
  137. ;; It is rude to delete a buffer which the command is not using.
  138. ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
  139. ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
  140. ;; (kill-buffer shell-buffer)))
  141. ;; Don't muck with mark unless REPLACE says we should.
  142. (and replace swap (exchange-point-and-mark)))
  143. ;; No prefix argument: put the output in a temp buffer,
  144. ;; replacing its entire contents.
  145. (let ((buffer (get-buffer-create
  146. (or output-buffer "*Shell Command Output*"))))
  147. (unwind-protect
  148. (if (eq buffer (current-buffer))
  149. ;; If the input is the same buffer as the output,
  150. ;; delete everything but the specified region,
  151. ;; then replace that region with the output.
  152. (progn (setq buffer-read-only nil)
  153. (delete-region (max start end) (point-max))
  154. (delete-region (point-min) (min start end))
  155. (setq exit-status
  156. (call-process-region (point-min) (point-max)
  157. shell-file-name t
  158. (if error-file
  159. (list t error-file)
  160. t)
  161. nil shell-command-switch
  162. command)))
  163. ;; Clear the output buffer, then run the command with
  164. ;; output there.
  165. (let ((directory default-directory))
  166. (with-current-buffer buffer
  167. (setq buffer-read-only nil)
  168. (if (not output-buffer)
  169. (setq default-directory directory))
  170. (erase-buffer)))
  171. (setq exit-status
  172. (call-process-region start end shell-file-name nil
  173. (if error-file
  174. (list buffer error-file)
  175. buffer)
  176. nil shell-command-switch command)))
  177. ;; Report the output.
  178. (with-current-buffer buffer
  179. (setq mode-line-process
  180. (cond ((null exit-status)
  181. " - Error")
  182. ((stringp exit-status)
  183. (format " - Signal [%s]" exit-status))
  184. ((not (equal 0 exit-status))
  185. (format " - Exit [%d]" exit-status)))))
  186. (if (with-current-buffer buffer (> (point-max) (point-min)))
  187. ;; There's some output, display it
  188. (display-message-or-buffer buffer)
  189. ;; No output; error?
  190. (let ((output
  191. (if (and error-file
  192. (< 0 (nth 7 (file-attributes error-file))))
  193. "some error output"
  194. "no output")))
  195. (cond ((null exit-status)
  196. (message "(Shell command failed with error)"))
  197. ((equal 0 exit-status)
  198. (message "(Shell command succeeded with %s)"
  199. output))
  200. ((stringp exit-status)
  201. (message "(Shell command killed by signal %s)"
  202. exit-status))
  203. (t
  204. (message "(Shell command failed with code %d and %s)"
  205. exit-status output))))
  206. ;; Don't kill: there might be useful info in the undo-log.
  207. ;; (kill-buffer buffer)
  208. ))))
  209. (when (and error-file (file-exists-p error-file))
  210. (if (< 0 (nth 7 (file-attributes error-file)))
  211. (with-current-buffer (get-buffer-create error-buffer)
  212. (let ((pos-from-end (- (point-max) (point))))
  213. (or (bobp)
  214. (insert "\f\n"))
  215. ;; Do no formatting while reading error file,
  216. ;; because that can run a shell command, and we
  217. ;; don't want that to cause an infinite recursion.
  218. (format-insert-file error-file nil)
  219. ;; Put point after the inserted errors.
  220. (goto-char (- (point-max) pos-from-end)))
  221. (and display-error-buffer
  222. (display-buffer (current-buffer)))))
  223. (delete-file error-file))
  224. exit-status))
  225. (defun org-babel-eval-wipe-error-buffer ()
  226. "Delete the contents of the Org code block error buffer.
  227. This buffer is named by `org-babel-error-buffer-name'."
  228. (when (get-buffer org-babel-error-buffer-name)
  229. (with-current-buffer org-babel-error-buffer-name
  230. (delete-region (point-min) (point-max)))))
  231. (provide 'ob-eval)
  232. ;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d
  233. ;;; ob-eval.el ends here