Commit | Line | Data |
---|---|---|
86fbb8ca CD |
1 | ;;; ob-comint.el --- org-babel functions for interaction with comint buffers |
2 | ||
3ab2c837 | 3 | ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. |
86fbb8ca CD |
4 | |
5 | ;; Author: Eric Schulte | |
6 | ;; Keywords: literate programming, reproducible research, comint | |
7 | ;; Homepage: http://orgmode.org | |
3ab2c837 | 8 | ;; Version: 7.7 |
86fbb8ca CD |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; These functions build on comint to ease the sending and receiving | |
28 | ;; of commands and results from comint buffers. | |
29 | ||
30 | ;; Note that the buffers in this file are analogous to sessions in | |
31 | ;; org-babel at large. | |
32 | ||
33 | ;;; Code: | |
34 | (require 'ob) | |
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) | |
54 | (error "buffer %s doesn't exist or has no process" ,buffer)) | |
55 | (set-buffer ,buffer) | |
56 | ,@body))) | |
57 | ||
58 | (defmacro org-babel-comint-with-output (meta &rest body) | |
59 | "Evaluate BODY in BUFFER and return process output. | |
60 | Will wait until EOE-INDICATOR appears in the output, then return | |
61 | all process output. If REMOVE-ECHO and FULL-BODY are present and | |
62 | non-nil, then strip echo'd body from the returned output. META | |
63 | should be a list containing the following where the last two | |
64 | elements are optional. | |
65 | ||
66 | (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) | |
67 | ||
68 | This macro ensures that the filter is removed in case of an error | |
69 | or user `keyboard-quit' during execution of body." | |
70 | (declare (indent 1)) | |
71 | (let ((buffer (car meta)) | |
72 | (eoe-indicator (cadr meta)) | |
73 | (remove-echo (cadr (cdr meta))) | |
74 | (full-body (cadr (cdr (cdr meta))))) | |
75 | `(org-babel-comint-in-buffer ,buffer | |
76 | (let ((string-buffer "") dangling-text raw) | |
77 | (flet ((my-filt (text) | |
78 | (setq string-buffer (concat string-buffer text)))) | |
79 | ;; setup filter | |
80 | (add-hook 'comint-output-filter-functions 'my-filt) | |
81 | (unwind-protect | |
82 | (progn | |
83 | ;; got located, and save dangling text | |
84 | (goto-char (process-mark (get-buffer-process (current-buffer)))) | |
85 | (let ((start (point)) | |
86 | (end (point-max))) | |
87 | (setq dangling-text (buffer-substring start end)) | |
88 | (delete-region start end)) | |
89 | ;; pass FULL-BODY to process | |
90 | ,@body | |
91 | ;; wait for end-of-evaluation indicator | |
92 | (while (progn | |
93 | (goto-char comint-last-input-end) | |
94 | (not (save-excursion | |
95 | (and (re-search-forward | |
3ab2c837 | 96 | (regexp-quote ,eoe-indicator) nil t) |
86fbb8ca | 97 | (re-search-forward |
3ab2c837 | 98 | comint-prompt-regexp nil t))))) |
86fbb8ca CD |
99 | (accept-process-output (get-buffer-process (current-buffer))) |
100 | ;; thought the following this would allow async | |
101 | ;; background running, but I was wrong... | |
102 | ;; (run-with-timer .5 .5 'accept-process-output | |
103 | ;; (get-buffer-process (current-buffer))) | |
104 | ) | |
105 | ;; replace cut dangling text | |
106 | (goto-char (process-mark (get-buffer-process (current-buffer)))) | |
107 | (insert dangling-text)) | |
108 | ;; remove filter | |
109 | (remove-hook 'comint-output-filter-functions 'my-filt))) | |
110 | ;; remove echo'd FULL-BODY from input | |
111 | (if (and ,remove-echo ,full-body | |
112 | (string-match | |
113 | (replace-regexp-in-string | |
114 | "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) | |
115 | string-buffer)) | |
116 | (setq raw (substring string-buffer (match-end 0)))) | |
117 | (split-string string-buffer comint-prompt-regexp))))) | |
118 | ||
119 | (defun org-babel-comint-input-command (buffer cmd) | |
120 | "Pass CMD to BUFFER. | |
121 | The input will not be echoed." | |
122 | (org-babel-comint-in-buffer buffer | |
123 | (goto-char (process-mark (get-buffer-process buffer))) | |
124 | (insert cmd) | |
125 | (comint-send-input) | |
126 | (org-babel-comint-wait-for-output buffer))) | |
127 | ||
128 | (defun org-babel-comint-wait-for-output (buffer) | |
129 | "Wait until output arrives from BUFFER. | |
130 | Note: this is only safe when waiting for the result of a single | |
131 | statement (not large blocks of code)." | |
132 | (org-babel-comint-in-buffer buffer | |
133 | (while (progn | |
134 | (goto-char comint-last-input-end) | |
135 | (not (and (re-search-forward comint-prompt-regexp nil t) | |
136 | (goto-char (match-beginning 0)) | |
137 | (string= (face-name (face-at-point)) | |
138 | "comint-highlight-prompt")))) | |
139 | (accept-process-output (get-buffer-process buffer))))) | |
140 | ||
afe98dfa CD |
141 | (defun org-babel-comint-eval-invisibly-and-wait-for-file |
142 | (buffer file string &optional period) | |
143 | "Evaluate STRING in BUFFER invisibly. | |
144 | Don't return until FILE exists. Code in STRING must ensure that | |
145 | FILE exists at end of evaluation." | |
146 | (unless (org-babel-comint-buffer-livep buffer) | |
147 | (error "buffer %s doesn't exist or has no process" buffer)) | |
148 | (if (file-exists-p file) (delete-file file)) | |
149 | (process-send-string | |
150 | (get-buffer-process buffer) | |
151 | (if (string-match "\n$" string) string (concat string "\n"))) | |
152 | ;; From Tramp 2.1.19 the following cache flush is not necessary | |
153 | (if (file-remote-p default-directory) | |
154 | (let (v) | |
155 | (with-parsed-tramp-file-name default-directory nil | |
156 | (tramp-flush-directory-property v "")))) | |
157 | (while (not (file-exists-p file)) (sit-for (or period 0.25)))) | |
158 | ||
86fbb8ca CD |
159 | (provide 'ob-comint) |
160 | ||
5b409b39 | 161 | |
86fbb8ca CD |
162 | |
163 | ;;; ob-comint.el ends here |