ob-comint.el 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314
  1. ;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research, comint
  5. ;; URL: https://orgmode.org
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; These functions build on comint to ease the sending and receiving
  19. ;; of commands and results from comint buffers.
  20. ;; Note that the buffers in this file are analogous to sessions in
  21. ;; org-babel at large.
  22. ;;; Code:
  23. (require 'org-macs)
  24. (org-assert-version)
  25. (require 'ob-core)
  26. (require 'org-compat)
  27. (require 'comint)
  28. (defun org-babel-comint-buffer-livep (buffer)
  29. "Check if BUFFER is a comint buffer with a live process."
  30. (let ((buffer (when buffer (get-buffer buffer))))
  31. (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer)))
  32. (defmacro org-babel-comint-in-buffer (buffer &rest body)
  33. "Check BUFFER and execute BODY.
  34. BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
  35. executed inside the protection of `save-excursion' and
  36. `save-match-data'."
  37. (declare (indent 1) (debug t))
  38. `(progn
  39. (unless (org-babel-comint-buffer-livep ,buffer)
  40. (error "Buffer %s does not exist or has no process" ,buffer))
  41. (save-match-data
  42. (with-current-buffer ,buffer
  43. (save-excursion
  44. (let ((comint-input-filter (lambda (_input) nil)))
  45. ,@body))))))
  46. (defmacro org-babel-comint-with-output (meta &rest body)
  47. "Evaluate BODY in BUFFER and return process output.
  48. Will wait until EOE-INDICATOR appears in the output, then return
  49. all process output. If REMOVE-ECHO and FULL-BODY are present and
  50. non-nil, then strip echo'd body from the returned output. META
  51. should be a list containing the following where the last two
  52. elements are optional.
  53. (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY)
  54. This macro ensures that the filter is removed in case of an error
  55. or user `keyboard-quit' during execution of body."
  56. (declare (indent 1) (debug (sexp body)))
  57. (let ((buffer (nth 0 meta))
  58. (eoe-indicator (nth 1 meta))
  59. (remove-echo (nth 2 meta))
  60. (full-body (nth 3 meta)))
  61. `(org-babel-comint-in-buffer ,buffer
  62. (let* ((string-buffer "")
  63. (comint-output-filter-functions
  64. (cons (lambda (text) (setq string-buffer (concat string-buffer text)))
  65. comint-output-filter-functions))
  66. dangling-text)
  67. ;; got located, and save dangling text
  68. (goto-char (process-mark (get-buffer-process (current-buffer))))
  69. (let ((start (point))
  70. (end (point-max)))
  71. (setq dangling-text (buffer-substring start end))
  72. (delete-region start end))
  73. ;; pass FULL-BODY to process
  74. ,@body
  75. ;; wait for end-of-evaluation indicator
  76. (while (progn
  77. (goto-char comint-last-input-end)
  78. (not (save-excursion
  79. (and (re-search-forward
  80. (regexp-quote ,eoe-indicator) nil t)
  81. (re-search-forward
  82. comint-prompt-regexp nil t)))))
  83. (accept-process-output (get-buffer-process (current-buffer))))
  84. ;; replace cut dangling text
  85. (goto-char (process-mark (get-buffer-process (current-buffer))))
  86. (insert dangling-text)
  87. ;; remove echo'd FULL-BODY from input
  88. (when (and ,remove-echo ,full-body
  89. (string-match
  90. (replace-regexp-in-string
  91. "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
  92. string-buffer))
  93. (setq string-buffer (substring string-buffer (match-end 0))))
  94. (split-string string-buffer comint-prompt-regexp)))))
  95. (defun org-babel-comint-input-command (buffer cmd)
  96. "Pass CMD to BUFFER.
  97. The input will not be echoed."
  98. (org-babel-comint-in-buffer buffer
  99. (goto-char (process-mark (get-buffer-process buffer)))
  100. (insert cmd)
  101. (comint-send-input)
  102. (org-babel-comint-wait-for-output buffer)))
  103. (defun org-babel-comint-wait-for-output (buffer)
  104. "Wait until output arrives from BUFFER.
  105. Note: this is only safe when waiting for the result of a single
  106. statement (not large blocks of code)."
  107. (org-babel-comint-in-buffer buffer
  108. (while (progn
  109. (goto-char comint-last-input-end)
  110. (not (and (re-search-forward comint-prompt-regexp nil t)
  111. (goto-char (match-beginning 0)))))
  112. (accept-process-output (get-buffer-process buffer)))))
  113. (defun org-babel-comint-eval-invisibly-and-wait-for-file
  114. (buffer file string &optional period)
  115. "Evaluate STRING in BUFFER invisibly.
  116. Don't return until FILE exists. Code in STRING must ensure that
  117. FILE exists at end of evaluation."
  118. (unless (org-babel-comint-buffer-livep buffer)
  119. (error "Buffer %s does not exist or has no process" buffer))
  120. (when (file-exists-p file) (delete-file file))
  121. (process-send-string
  122. (get-buffer-process buffer)
  123. (if (= (aref string (1- (length string))) ?\n) string (concat string "\n")))
  124. (while (not (file-exists-p file)) (sit-for (or period 0.25))))
  125. ;;; Async evaluation
  126. (defvar-local org-babel-comint-async-indicator nil
  127. "Regular expression that `org-babel-comint-async-filter' scans for.
  128. It should have 2 parenthesized expressions,
  129. e.g. \"org_babel_async_\\(start\\|end\\|file\\)_\\(.*\\)\". The
  130. first parenthesized expression determines whether the token is
  131. delimiting a result block, or whether the result is in a file.
  132. If delimiting a block, the second expression gives a UUID for the
  133. location to insert the result. Otherwise, the result is in a tmp
  134. file, and the second expression gives the file name.")
  135. (defvar-local org-babel-comint-async-buffers nil
  136. "List of Org mode buffers to check for Babel async output results.")
  137. (defvar-local org-babel-comint-async-file-callback nil
  138. "Callback to clean and insert Babel async results from a temp file.
  139. The callback function takes two arguments: the alist of params of the Babel
  140. source block, and the name of the temp file.")
  141. (defvar-local org-babel-comint-async-chunk-callback nil
  142. "Callback function to clean Babel async output results before insertion.
  143. Its single argument is a string consisting of output from the
  144. comint process. It should return a string that will be be passed
  145. to `org-babel-insert-result'.")
  146. (defvar-local org-babel-comint-async-dangling nil
  147. "Dangling piece of the last process output, in case
  148. `org-babel-comint-async-indicator' is spread across multiple
  149. comint outputs due to buffering.")
  150. (defun org-babel-comint-use-async (params)
  151. "Determine whether to use session async evaluation.
  152. PARAMS are the header arguments as passed to
  153. `org-babel-execute:lang'."
  154. (let ((async (assq :async params))
  155. (session (assq :session params)))
  156. (and async
  157. (not org-babel-exp-reference-buffer)
  158. (not (equal (cdr async) "no"))
  159. (not (equal (cdr session) "none")))))
  160. (defun org-babel-comint-async-filter (string)
  161. "Captures Babel async output from comint buffer back to Org mode buffers.
  162. This function is added as a hook to `comint-output-filter-functions'.
  163. STRING contains the output originally inserted into the comint buffer."
  164. ;; Remove outdated Org mode buffers
  165. (setq org-babel-comint-async-buffers
  166. (cl-loop for buf in org-babel-comint-async-buffers
  167. if (buffer-live-p buf)
  168. collect buf))
  169. (let* ((indicator org-babel-comint-async-indicator)
  170. (org-buffers org-babel-comint-async-buffers)
  171. (file-callback org-babel-comint-async-file-callback)
  172. (combined-string (concat org-babel-comint-async-dangling string))
  173. (new-dangling combined-string)
  174. ;; list of UUID's matched by `org-babel-comint-async-indicator'
  175. uuid-list)
  176. (with-temp-buffer
  177. (insert combined-string)
  178. (goto-char (point-min))
  179. (while (re-search-forward indicator nil t)
  180. ;; update dangling
  181. (setq new-dangling (buffer-substring (point) (point-max)))
  182. (cond ((equal (match-string 1) "end")
  183. ;; save UUID for insertion later
  184. (push (match-string 2) uuid-list))
  185. ((equal (match-string 1) "file")
  186. ;; insert results from tmp-file
  187. (let ((tmp-file (match-string 2)))
  188. (cl-loop for buf in org-buffers
  189. until
  190. (with-current-buffer buf
  191. (save-excursion
  192. (goto-char (point-min))
  193. (when (search-forward tmp-file nil t)
  194. (org-babel-previous-src-block)
  195. (let* ((info (org-babel-get-src-block-info))
  196. (params (nth 2 info))
  197. (result-params
  198. (cdr (assq :result-params params))))
  199. (org-babel-insert-result
  200. (funcall file-callback
  201. (nth
  202. 2 (org-babel-get-src-block-info))
  203. tmp-file)
  204. result-params info))
  205. t))))))))
  206. ;; Truncate dangling to only the most recent output
  207. (when (> (length new-dangling) (length string))
  208. (setq new-dangling string)))
  209. (setq-local org-babel-comint-async-dangling new-dangling)
  210. (when uuid-list
  211. ;; Search for results in the comint buffer
  212. (save-excursion
  213. (goto-char (point-max))
  214. (while uuid-list
  215. (re-search-backward indicator)
  216. (when (equal (match-string 1) "end")
  217. (let* ((uuid (match-string-no-properties 2))
  218. (res-str-raw
  219. (buffer-substring
  220. ;; move point to beginning of indicator
  221. (- (match-beginning 0) 1)
  222. ;; find the matching start indicator
  223. (cl-loop
  224. do (re-search-backward indicator)
  225. until (and (equal (match-string 1) "start")
  226. (equal (match-string 2) uuid))
  227. finally return (+ 1 (match-end 0)))))
  228. ;; Apply callback to clean up the result
  229. (res-str (funcall org-babel-comint-async-chunk-callback
  230. res-str-raw)))
  231. ;; Search for uuid in associated org-buffers to insert results
  232. (cl-loop for buf in org-buffers
  233. until (with-current-buffer buf
  234. (save-excursion
  235. (goto-char (point-min))
  236. (when (search-forward uuid nil t)
  237. (org-babel-previous-src-block)
  238. (let* ((info (org-babel-get-src-block-info))
  239. (params (nth 2 info))
  240. (result-params
  241. (cdr (assq :result-params params))))
  242. (org-babel-insert-result
  243. res-str result-params info))
  244. t))))
  245. ;; Remove uuid from the list to search for
  246. (setq uuid-list (delete uuid uuid-list)))))))))
  247. (defun org-babel-comint-async-register
  248. (session-buffer org-buffer indicator-regexp
  249. chunk-callback file-callback)
  250. "Set local org-babel-comint-async variables in SESSION-BUFFER.
  251. ORG-BUFFER is added to `org-babel-comint-async-buffers' if not
  252. present. `org-babel-comint-async-indicator',
  253. `org-babel-comint-async-chunk-callback', and
  254. `org-babel-comint-async-file-callback' are set to
  255. INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK
  256. respectively."
  257. (org-babel-comint-in-buffer session-buffer
  258. (setq org-babel-comint-async-indicator indicator-regexp
  259. org-babel-comint-async-chunk-callback chunk-callback
  260. org-babel-comint-async-file-callback file-callback)
  261. (unless (memq org-buffer org-babel-comint-async-buffers)
  262. (setq org-babel-comint-async-buffers
  263. (cons org-buffer org-babel-comint-async-buffers)))
  264. (add-hook 'comint-output-filter-functions
  265. 'org-babel-comint-async-filter nil t)))
  266. (defmacro org-babel-comint-async-delete-dangling-and-eval
  267. (session-buffer &rest body)
  268. "Remove dangling text in SESSION-BUFFER and evaluate BODY.
  269. This is analogous to `org-babel-comint-with-output', but meant
  270. for asynchronous output, and much shorter because inserting the
  271. result is delegated to `org-babel-comint-async-filter'."
  272. (declare (indent 1) (debug t))
  273. `(org-babel-comint-in-buffer ,session-buffer
  274. (goto-char (process-mark (get-buffer-process (current-buffer))))
  275. (delete-region (point) (point-max))
  276. ,@body))
  277. (provide 'ob-comint)
  278. ;;; ob-comint.el ends here