1 ;;; ob-comint.el --- org-babel functions for interaction with comint buffers
3 ;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
5 ;; Author: Eric Schulte
6 ;; Keywords: literate programming, reproducible research, comint
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
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.
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.
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/>.
26 ;; These functions build on comint to ease the sending and receiving
27 ;; of commands and results from comint buffers.
29 ;; Note that the buffers in this file are analogous to sessions in
30 ;; org-babel at large.
36 (eval-when-compile (require 'cl
))
37 (declare-function with-parsed-tramp-file-name
"tramp"
38 (filename var
&rest body
) t
)
39 (declare-function tramp-flush-directory-property
"tramp-cache" (key directory
))
41 (defun org-babel-comint-buffer-livep (buffer)
42 "Check if BUFFER is a comint buffer with a live process."
43 (let ((buffer (if buffer
(get-buffer buffer
))))
44 (and buffer
(buffer-live-p buffer
) (get-buffer-process buffer
) buffer
)))
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
53 (unless (org-babel-comint-buffer-livep ,buffer
)
54 (error "Buffer %s does not exist or has no process" ,buffer
))
56 (with-current-buffer ,buffer
57 (let ((comint-input-filter (lambda (input) nil
)))
59 (def-edebug-spec org-babel-comint-in-buffer
(form body
))
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.
69 (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY)
71 This macro ensures that the filter is removed in case of an error
72 or user `keyboard-quit' during execution of 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-in-buffer ,buffer
79 (let* ((string-buffer "")
80 (comint-output-filter-functions
81 (cons (lambda (text) (setq string-buffer
(concat string-buffer text
)))
82 comint-output-filter-functions
))
84 ;; got located, and save dangling text
85 (goto-char (process-mark (get-buffer-process (current-buffer))))
88 (setq dangling-text
(buffer-substring start end
))
89 (delete-region start end
))
90 ;; pass FULL-BODY to process
92 ;; wait for end-of-evaluation indicator
94 (goto-char comint-last-input-end
)
96 (and (re-search-forward
97 (regexp-quote ,eoe-indicator
) nil t
)
99 comint-prompt-regexp nil t
)))))
100 (accept-process-output (get-buffer-process (current-buffer)))
101 ;; thought the following this would allow async
102 ;; background running, but I was wrong...
103 ;; (run-with-timer .5 .5 'accept-process-output
104 ;; (get-buffer-process (current-buffer)))
106 ;; replace cut dangling text
107 (goto-char (process-mark (get-buffer-process (current-buffer))))
108 (insert dangling-text
)
110 ;; remove echo'd FULL-BODY from input
111 (if (and ,remove-echo
,full-body
113 (replace-regexp-in-string
114 "\n" "[\r\n]+" (regexp-quote (or ,full-body
"")))
116 (setq raw
(substring string-buffer
(match-end 0))))
117 (split-string string-buffer comint-prompt-regexp
)))))
118 (def-edebug-spec org-babel-comint-with-output
(sexp body
))
120 (defun org-babel-comint-input-command (buffer cmd
)
122 The input will not be echoed."
123 (org-babel-comint-in-buffer buffer
124 (goto-char (process-mark (get-buffer-process buffer
)))
127 (org-babel-comint-wait-for-output buffer
)))
129 (defun org-babel-comint-wait-for-output (buffer)
130 "Wait until output arrives from BUFFER.
131 Note: this is only safe when waiting for the result of a single
132 statement (not large blocks of code)."
133 (org-babel-comint-in-buffer buffer
135 (goto-char comint-last-input-end
)
136 (not (and (re-search-forward comint-prompt-regexp nil t
)
137 (goto-char (match-beginning 0))
138 (string= (face-name (face-at-point))
139 "comint-highlight-prompt"))))
140 (accept-process-output (get-buffer-process buffer
)))))
142 (defun org-babel-comint-eval-invisibly-and-wait-for-file
143 (buffer file string
&optional period
)
144 "Evaluate STRING in BUFFER invisibly.
145 Don't return until FILE exists. Code in STRING must ensure that
146 FILE exists at end of evaluation."
147 (unless (org-babel-comint-buffer-livep buffer
)
148 (error "Buffer %s does not exist or has no process" buffer
))
149 (if (file-exists-p file
) (delete-file file
))
151 (get-buffer-process buffer
)
152 (if (= (aref string
(1- (length string
))) ?
\n) string
(concat string
"\n")))
153 ;; From Tramp 2.1.19 the following cache flush is not necessary
154 (if (file-remote-p default-directory
)
156 (with-parsed-tramp-file-name default-directory nil
157 (tramp-flush-directory-property v
""))))
158 (while (not (file-exists-p file
)) (sit-for (or period
0.25))))
164 ;;; ob-comint.el ends here