Commit | Line | Data |
---|---|---|
86fbb8ca CD |
1 | ;;; ob-comint.el --- org-babel functions for interaction with comint buffers |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2009-2013 Free Software Foundation, Inc. |
86fbb8ca CD |
4 | |
5 | ;; Author: Eric Schulte | |
6 | ;; Keywords: literate programming, reproducible research, comint | |
7 | ;; Homepage: http://orgmode.org | |
86fbb8ca CD |
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 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 | (require 'ob) | |
8223b1d2 | 34 | (require 'org-compat) |
86fbb8ca CD |
35 | (require 'comint) |
36 | (eval-when-compile (require 'cl)) | |
afe98dfa CD |
37 | (declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) |
38 | (declare-function tramp-flush-directory-property "tramp" (vec directory)) | |
86fbb8ca CD |
39 | |
40 | (defun org-babel-comint-buffer-livep (buffer) | |
41 | "Check if BUFFER is a comint buffer with a live process." | |
42 | (let ((buffer (if buffer (get-buffer buffer)))) | |
43 | (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) | |
44 | ||
45 | (defmacro org-babel-comint-in-buffer (buffer &rest body) | |
46 | "Check BUFFER and execute BODY. | |
47 | BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is | |
afe98dfa | 48 | executed inside the protection of `save-excursion' and |
86fbb8ca CD |
49 | `save-match-data'." |
50 | (declare (indent 1)) | |
51 | `(save-excursion | |
52 | (save-match-data | |
53 | (unless (org-babel-comint-buffer-livep ,buffer) | |
8223b1d2 | 54 | (error "Buffer %s does not exist or has no process" ,buffer)) |
86fbb8ca CD |
55 | (set-buffer ,buffer) |
56 | ,@body))) | |
e66ba1df | 57 | (def-edebug-spec org-babel-comint-in-buffer (form body)) |
86fbb8ca CD |
58 | |
59 | (defmacro org-babel-comint-with-output (meta &rest body) | |
60 | "Evaluate BODY in BUFFER and return process output. | |
61 | Will wait until EOE-INDICATOR appears in the output, then return | |
62 | all process output. If REMOVE-ECHO and FULL-BODY are present and | |
63 | non-nil, then strip echo'd body from the returned output. META | |
64 | should be a list containing the following where the last two | |
65 | elements are optional. | |
66 | ||
67 | (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) | |
68 | ||
69 | This macro ensures that the filter is removed in case of an error | |
70 | or user `keyboard-quit' during execution of body." | |
71 | (declare (indent 1)) | |
72 | (let ((buffer (car meta)) | |
73 | (eoe-indicator (cadr meta)) | |
74 | (remove-echo (cadr (cdr meta))) | |
75 | (full-body (cadr (cdr (cdr meta))))) | |
76 | `(org-babel-comint-in-buffer ,buffer | |
77 | (let ((string-buffer "") dangling-text raw) | |
8223b1d2 BG |
78 | ;; setup filter |
79 | (setq comint-output-filter-functions | |
80 | (cons (lambda (text) (setq string-buffer (concat string-buffer text))) | |
81 | comint-output-filter-functions)) | |
82 | (unwind-protect | |
83 | (progn | |
84 | ;; got located, and save dangling text | |
85 | (goto-char (process-mark (get-buffer-process (current-buffer)))) | |
86 | (let ((start (point)) | |
87 | (end (point-max))) | |
88 | (setq dangling-text (buffer-substring start end)) | |
89 | (delete-region start end)) | |
90 | ;; pass FULL-BODY to process | |
91 | ,@body | |
92 | ;; wait for end-of-evaluation indicator | |
93 | (while (progn | |
94 | (goto-char comint-last-input-end) | |
95 | (not (save-excursion | |
96 | (and (re-search-forward | |
97 | (regexp-quote ,eoe-indicator) nil t) | |
98 | (re-search-forward | |
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))) | |
105 | ) | |
106 | ;; replace cut dangling text | |
107 | (goto-char (process-mark (get-buffer-process (current-buffer)))) | |
108 | (insert dangling-text)) | |
109 | ;; remove filter | |
110 | (setq comint-output-filter-functions | |
111 | (cdr comint-output-filter-functions))) | |
86fbb8ca CD |
112 | ;; remove echo'd FULL-BODY from input |
113 | (if (and ,remove-echo ,full-body | |
114 | (string-match | |
115 | (replace-regexp-in-string | |
116 | "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) | |
117 | string-buffer)) | |
118 | (setq raw (substring string-buffer (match-end 0)))) | |
119 | (split-string string-buffer comint-prompt-regexp))))) | |
e66ba1df | 120 | (def-edebug-spec org-babel-comint-with-output (form body)) |
86fbb8ca CD |
121 | |
122 | (defun org-babel-comint-input-command (buffer cmd) | |
123 | "Pass CMD to BUFFER. | |
124 | The input will not be echoed." | |
125 | (org-babel-comint-in-buffer buffer | |
126 | (goto-char (process-mark (get-buffer-process buffer))) | |
127 | (insert cmd) | |
128 | (comint-send-input) | |
129 | (org-babel-comint-wait-for-output buffer))) | |
130 | ||
131 | (defun org-babel-comint-wait-for-output (buffer) | |
132 | "Wait until output arrives from BUFFER. | |
133 | Note: this is only safe when waiting for the result of a single | |
134 | statement (not large blocks of code)." | |
135 | (org-babel-comint-in-buffer buffer | |
136 | (while (progn | |
137 | (goto-char comint-last-input-end) | |
138 | (not (and (re-search-forward comint-prompt-regexp nil t) | |
139 | (goto-char (match-beginning 0)) | |
140 | (string= (face-name (face-at-point)) | |
141 | "comint-highlight-prompt")))) | |
142 | (accept-process-output (get-buffer-process buffer))))) | |
143 | ||
afe98dfa CD |
144 | (defun org-babel-comint-eval-invisibly-and-wait-for-file |
145 | (buffer file string &optional period) | |
146 | "Evaluate STRING in BUFFER invisibly. | |
8223b1d2 | 147 | Don't return until FILE exists. Code in STRING must ensure that |
afe98dfa CD |
148 | FILE exists at end of evaluation." |
149 | (unless (org-babel-comint-buffer-livep buffer) | |
8223b1d2 | 150 | (error "Buffer %s does not exist or has no process" buffer)) |
afe98dfa CD |
151 | (if (file-exists-p file) (delete-file file)) |
152 | (process-send-string | |
153 | (get-buffer-process buffer) | |
154 | (if (string-match "\n$" string) string (concat string "\n"))) | |
155 | ;; From Tramp 2.1.19 the following cache flush is not necessary | |
156 | (if (file-remote-p default-directory) | |
157 | (let (v) | |
158 | (with-parsed-tramp-file-name default-directory nil | |
8223b1d2 | 159 | (tramp-flush-directory-property v "")))) |
afe98dfa CD |
160 | (while (not (file-exists-p file)) (sit-for (or period 0.25)))) |
161 | ||
86fbb8ca CD |
162 | (provide 'ob-comint) |
163 | ||
5b409b39 | 164 | |
86fbb8ca CD |
165 | |
166 | ;;; ob-comint.el ends here |