ob-comint.el (13985B)
1 ;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2023 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 on comint to ease the sending and receiving 27 ;; of commands and results from comint buffers. 28 29 ;; Note that the buffers in this file are analogous to sessions in 30 ;; org-babel at large. 31 32 ;;; Code: 33 34 (require 'org-macs) 35 (org-assert-version) 36 37 (require 'ob-core) 38 (require 'org-compat) 39 (require 'comint) 40 41 (defun org-babel-comint-buffer-livep (buffer) 42 "Check if BUFFER is a comint buffer with a live process." 43 (let ((buffer (when buffer (get-buffer buffer)))) 44 (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) 45 46 (defmacro org-babel-comint-in-buffer (buffer &rest body) 47 "Check BUFFER and execute BODY. 48 BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is 49 executed inside the protection of `save-excursion' and 50 `save-match-data'." 51 (declare (indent 1) (debug t)) 52 `(progn 53 (unless (org-babel-comint-buffer-livep ,buffer) 54 (error "Buffer %s does not exist or has no process" ,buffer)) 55 (save-match-data 56 (with-current-buffer ,buffer 57 (save-excursion 58 (let ((comint-input-filter (lambda (_input) nil))) 59 ,@body)))))) 60 61 (defmacro org-babel-comint-with-output (meta &rest body) 62 "Evaluate BODY in BUFFER and return process output. 63 Will wait until EOE-INDICATOR appears in the output, then return 64 all process output. If REMOVE-ECHO and FULL-BODY are present and 65 non-nil, then strip echo'd body from the returned output. META 66 should be a list containing the following where the last two 67 elements are optional. 68 69 (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) 70 71 This macro ensures that the filter is removed in case of an error 72 or user `keyboard-quit' during execution of body." 73 (declare (indent 1) (debug (sexp body))) 74 (let ((buffer (nth 0 meta)) 75 (eoe-indicator (nth 1 meta)) 76 (remove-echo (nth 2 meta)) 77 (full-body (nth 3 meta)) 78 (org-babel-comint-prompt-separator 79 "org-babel-comint-prompt-separator")) 80 `(org-babel-comint-in-buffer ,buffer 81 (let* ((string-buffer "") 82 (comint-output-filter-functions 83 (cons (lambda (text) 84 (setq string-buffer 85 (concat 86 string-buffer 87 ;; Upon concatenation, the prompt may no 88 ;; longer match `comint-prompt-regexp'. 89 ;; In particular, when the regexp has ^ 90 ;; and the output does not contain 91 ;; trailing newline. Use more reliable 92 ;; match to split the output later. 93 (replace-regexp-in-string 94 comint-prompt-regexp 95 ,org-babel-comint-prompt-separator 96 text)))) 97 comint-output-filter-functions)) 98 dangling-text) 99 ;; got located, and save dangling text 100 (goto-char (process-mark (get-buffer-process (current-buffer)))) 101 (let ((start (point)) 102 (end (point-max))) 103 (setq dangling-text (buffer-substring start end)) 104 (delete-region start end)) 105 ;; pass FULL-BODY to process 106 ,@body 107 ;; wait for end-of-evaluation indicator 108 (while (progn 109 (goto-char comint-last-input-end) 110 (not (save-excursion 111 (and (re-search-forward 112 (regexp-quote ,eoe-indicator) nil t) 113 (re-search-forward 114 comint-prompt-regexp nil t))))) 115 (accept-process-output (get-buffer-process (current-buffer)))) 116 ;; replace cut dangling text 117 (goto-char (process-mark (get-buffer-process (current-buffer)))) 118 (insert dangling-text) 119 120 ;; Replace partially supplied input lines. 121 ;; This is needed when output filter spits partial lines that 122 ;; do not include a full prompt at a time. 123 (setq string-buffer 124 (replace-regexp-in-string 125 comint-prompt-regexp 126 ,org-babel-comint-prompt-separator 127 string-buffer)) 128 ;; remove echo'd FULL-BODY from input 129 (when (and ,remove-echo ,full-body 130 (string-match 131 (replace-regexp-in-string 132 "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) 133 string-buffer)) 134 (setq string-buffer (substring string-buffer (match-end 0)))) 135 (delete "" (split-string 136 string-buffer 137 ,org-babel-comint-prompt-separator)))))) 138 139 (defun org-babel-comint-input-command (buffer cmd) 140 "Pass CMD to BUFFER. 141 The input will not be echoed." 142 (org-babel-comint-in-buffer buffer 143 (goto-char (process-mark (get-buffer-process buffer))) 144 (insert cmd) 145 (comint-send-input) 146 (org-babel-comint-wait-for-output buffer))) 147 148 (defun org-babel-comint-wait-for-output (buffer) 149 "Wait until output arrives from BUFFER. 150 Note: this is only safe when waiting for the result of a single 151 statement (not large blocks of code)." 152 (org-babel-comint-in-buffer buffer 153 (while (progn 154 (goto-char comint-last-input-end) 155 (not (and (re-search-forward comint-prompt-regexp nil t) 156 (goto-char (match-beginning 0))))) 157 (accept-process-output (get-buffer-process buffer))))) 158 159 (defun org-babel-comint-eval-invisibly-and-wait-for-file 160 (buffer file string &optional period) 161 "Evaluate STRING in BUFFER invisibly. 162 Don't return until FILE exists. Code in STRING must ensure that 163 FILE exists at end of evaluation." 164 (unless (org-babel-comint-buffer-livep buffer) 165 (error "Buffer %s does not exist or has no process" buffer)) 166 (when (file-exists-p file) (delete-file file)) 167 (process-send-string 168 (get-buffer-process buffer) 169 (if (= (aref string (1- (length string))) ?\n) string (concat string "\n"))) 170 (while (not (file-exists-p file)) (sit-for (or period 0.25)))) 171 172 173 ;;; Async evaluation 174 175 (defvar-local org-babel-comint-async-indicator nil 176 "Regular expression that `org-babel-comint-async-filter' scans for. 177 It should have 2 parenthesized expressions, 178 e.g. \"org_babel_async_\\(start\\|end\\|file\\)_\\(.*\\)\". The 179 first parenthesized expression determines whether the token is 180 delimiting a result block, or whether the result is in a file. 181 If delimiting a block, the second expression gives a UUID for the 182 location to insert the result. Otherwise, the result is in a tmp 183 file, and the second expression gives the file name.") 184 185 (defvar-local org-babel-comint-async-buffers nil 186 "List of Org mode buffers to check for Babel async output results.") 187 188 (defvar-local org-babel-comint-async-file-callback nil 189 "Callback to clean and insert Babel async results from a temp file. 190 The callback function takes two arguments: the alist of params of the Babel 191 source block, and the name of the temp file.") 192 193 (defvar-local org-babel-comint-async-chunk-callback nil 194 "Callback function to clean Babel async output results before insertion. 195 Its single argument is a string consisting of output from the 196 comint process. It should return a string that will be passed 197 to `org-babel-insert-result'.") 198 199 (defvar-local org-babel-comint-async-dangling nil 200 "Dangling piece of the last process output, in case 201 `org-babel-comint-async-indicator' is spread across multiple 202 comint outputs due to buffering.") 203 204 (defun org-babel-comint-use-async (params) 205 "Determine whether to use session async evaluation. 206 PARAMS are the header arguments as passed to 207 `org-babel-execute:lang'." 208 (let ((async (assq :async params)) 209 (session (assq :session params))) 210 (and async 211 (not org-babel-exp-reference-buffer) 212 (not (equal (cdr async) "no")) 213 (not (equal (cdr session) "none"))))) 214 215 (defun org-babel-comint-async-filter (string) 216 "Captures Babel async output from comint buffer back to Org mode buffers. 217 This function is added as a hook to `comint-output-filter-functions'. 218 STRING contains the output originally inserted into the comint buffer." 219 ;; Remove outdated Org mode buffers 220 (setq org-babel-comint-async-buffers 221 (cl-loop for buf in org-babel-comint-async-buffers 222 if (buffer-live-p buf) 223 collect buf)) 224 (let* ((indicator org-babel-comint-async-indicator) 225 (org-buffers org-babel-comint-async-buffers) 226 (file-callback org-babel-comint-async-file-callback) 227 (combined-string (concat org-babel-comint-async-dangling string)) 228 (new-dangling combined-string) 229 ;; list of UUID's matched by `org-babel-comint-async-indicator' 230 uuid-list) 231 (with-temp-buffer 232 (insert combined-string) 233 (goto-char (point-min)) 234 (while (re-search-forward indicator nil t) 235 ;; update dangling 236 (setq new-dangling (buffer-substring (point) (point-max))) 237 (cond ((equal (match-string 1) "end") 238 ;; save UUID for insertion later 239 (push (match-string 2) uuid-list)) 240 ((equal (match-string 1) "file") 241 ;; insert results from tmp-file 242 (let ((tmp-file (match-string 2))) 243 (cl-loop for buf in org-buffers 244 until 245 (with-current-buffer buf 246 (save-excursion 247 (goto-char (point-min)) 248 (when (search-forward tmp-file nil t) 249 (org-babel-previous-src-block) 250 (let* ((info (org-babel-get-src-block-info)) 251 (params (nth 2 info)) 252 (result-params 253 (cdr (assq :result-params params)))) 254 (org-babel-insert-result 255 (funcall file-callback 256 (nth 257 2 (org-babel-get-src-block-info)) 258 tmp-file) 259 result-params info)) 260 t)))))))) 261 ;; Truncate dangling to only the most recent output 262 (when (> (length new-dangling) (length string)) 263 (setq new-dangling string))) 264 (setq-local org-babel-comint-async-dangling new-dangling) 265 (when uuid-list 266 ;; Search for results in the comint buffer 267 (save-excursion 268 (goto-char (point-max)) 269 (while uuid-list 270 (re-search-backward indicator) 271 (when (equal (match-string 1) "end") 272 (let* ((uuid (match-string-no-properties 2)) 273 (res-str-raw 274 (buffer-substring 275 ;; move point to beginning of indicator 276 (- (match-beginning 0) 1) 277 ;; find the matching start indicator 278 (cl-loop 279 do (re-search-backward indicator) 280 until (and (equal (match-string 1) "start") 281 (equal (match-string 2) uuid)) 282 finally return (+ 1 (match-end 0))))) 283 ;; Apply callback to clean up the result 284 (res-str (funcall org-babel-comint-async-chunk-callback 285 res-str-raw))) 286 ;; Search for uuid in associated org-buffers to insert results 287 (cl-loop for buf in org-buffers 288 until (with-current-buffer buf 289 (save-excursion 290 (goto-char (point-min)) 291 (when (search-forward uuid nil t) 292 (org-babel-previous-src-block) 293 (let* ((info (org-babel-get-src-block-info)) 294 (params (nth 2 info)) 295 (result-params 296 (cdr (assq :result-params params)))) 297 (org-babel-insert-result 298 res-str result-params info)) 299 t)))) 300 ;; Remove uuid from the list to search for 301 (setq uuid-list (delete uuid uuid-list))))))))) 302 303 (defun org-babel-comint-async-register 304 (session-buffer org-buffer indicator-regexp 305 chunk-callback file-callback) 306 "Set local org-babel-comint-async variables in SESSION-BUFFER. 307 ORG-BUFFER is added to `org-babel-comint-async-buffers' if not 308 present. `org-babel-comint-async-indicator', 309 `org-babel-comint-async-chunk-callback', and 310 `org-babel-comint-async-file-callback' are set to 311 INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK 312 respectively." 313 (org-babel-comint-in-buffer session-buffer 314 (setq org-babel-comint-async-indicator indicator-regexp 315 org-babel-comint-async-chunk-callback chunk-callback 316 org-babel-comint-async-file-callback file-callback) 317 (unless (memq org-buffer org-babel-comint-async-buffers) 318 (setq org-babel-comint-async-buffers 319 (cons org-buffer org-babel-comint-async-buffers))) 320 (add-hook 'comint-output-filter-functions 321 'org-babel-comint-async-filter nil t))) 322 323 (defmacro org-babel-comint-async-delete-dangling-and-eval 324 (session-buffer &rest body) 325 "Remove dangling text in SESSION-BUFFER and evaluate BODY. 326 This is analogous to `org-babel-comint-with-output', but meant 327 for asynchronous output, and much shorter because inserting the 328 result is delegated to `org-babel-comint-async-filter'." 329 (declare (indent 1) (debug t)) 330 `(org-babel-comint-in-buffer ,session-buffer 331 (goto-char (process-mark (get-buffer-process (current-buffer)))) 332 (delete-region (point) (point-max)) 333 ,@body)) 334 335 (provide 'ob-comint) 336 337 338 339 ;;; ob-comint.el ends here