Commit | Line | Data |
---|---|---|
abeffda9 ER |
1 | ;;; tq.el --- utility to maintain a transaction queue |
2 | ||
d59c3137 | 3 | ;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, |
5df4f04c | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
58142744 | 5 | |
83023647 | 6 | ;; Author: Scott Draves <spot@cs.cmu.edu> |
e29b94be | 7 | ;; Maintainer: FSF |
83023647 | 8 | ;; Adapted-By: ESR |
d7b4d18f | 9 | ;; Keywords: extensions |
83023647 | 10 | |
58142744 ER |
11 | ;; This file is part of GNU Emacs. |
12 | ||
d6cba7ae | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
58142744 | 14 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
58142744 ER |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
d6cba7ae | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
58142744 ER |
25 | |
26 | ;;; Commentary: | |
a1506d29 | 27 | |
51fa34bc MB |
28 | ;; This file manages receiving a stream asynchronously, parsing it |
29 | ;; into transactions, and then calling the associated handler function | |
30 | ;; upon the completion of each transaction. | |
abeffda9 | 31 | |
d8754ce5 | 32 | ;; Our basic structure is the queue/process/buffer triple. Each entry |
51fa34bc MB |
33 | ;; of the queue part is a list of question, regexp, closure, and |
34 | ;; function that is consed to the last element. | |
35 | ||
36 | ;; A transaction queue may be created by calling `tq-create'. | |
37 | ||
38 | ;; A request may be added to the queue by calling `tq-enqueue'. If | |
39 | ;; the `delay-question' argument is non-nil, we will wait to send the | |
40 | ;; question to the process until it has finished sending other input. | |
41 | ;; Otherwise, once a request is enqueued, we send the given question | |
42 | ;; immediately to the process. | |
43 | ||
44 | ;; We then buffer bytes from the process until we see the regexp that | |
45 | ;; was provided in the call to `tq-enqueue'. Then we call the | |
46 | ;; provided function with the closure and the collected bytes. If we | |
47 | ;; have indicated that the question from the next transaction was not | |
48 | ;; sent immediately, send it at this point, awaiting the response. | |
abeffda9 | 49 | |
83023647 | 50 | ;;; Code: |
abeffda9 | 51 | |
51fa34bc MB |
52 | ;;; Accessors |
53 | ||
54 | ;; This part looks like (queue . (process . buffer)) | |
55 | (defun tq-queue (tq) (car tq)) | |
56 | (defun tq-process (tq) (car (cdr tq))) | |
57 | (defun tq-buffer (tq) (cdr (cdr tq))) | |
58 | ||
59 | ;; The structure of `queue' is as follows | |
60 | ;; ((question regexp closure . fn) | |
61 | ;; <other queue entries>) | |
62 | ;; question: string to send to the process | |
63 | (defun tq-queue-head-question (tq) (car (car (tq-queue tq)))) | |
64 | ;; regexp: regular expression that matches the end of a response from | |
65 | ;; the process | |
66 | (defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) | |
7a210b69 | 67 | ;; closure: additional data to pass to the function |
51fa34bc MB |
68 | (defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) |
69 | ;; fn: function to call upon receiving a complete response from the | |
70 | ;; process | |
71 | (defun tq-queue-head-fn (tq) (cdr (cdr (cdr (car (tq-queue tq)))))) | |
72 | ||
73 | ;; Determine whether queue is empty | |
74 | (defun tq-queue-empty (tq) (not (tq-queue tq))) | |
75 | ||
76 | ;;; Core functionality | |
77 | ||
09f11993 | 78 | ;;;###autoload |
abeffda9 | 79 | (defun tq-create (process) |
09f11993 RS |
80 | "Create and return a transaction queue communicating with PROCESS. |
81 | PROCESS should be a subprocess capable of sending and receiving | |
82 | streams of bytes. It may be a local process, or it may be connected | |
83 | to a tcp server on another machine." | |
abeffda9 ER |
84 | (let ((tq (cons nil (cons process |
85 | (generate-new-buffer | |
86 | (concat " tq-temp-" | |
87 | (process-name process))))))) | |
a7be409c | 88 | (buffer-disable-undo (tq-buffer tq)) |
abeffda9 | 89 | (set-process-filter process |
13453b12 | 90 | `(lambda (proc string) |
2b652064 | 91 | (tq-filter ',tq string))) |
abeffda9 ER |
92 | tq)) |
93 | ||
51fa34bc | 94 | (defun tq-queue-add (tq question re closure fn) |
abeffda9 | 95 | (setcar tq (nconc (tq-queue tq) |
51fa34bc | 96 | (cons (cons question (cons re (cons closure fn))) nil))) |
abeffda9 ER |
97 | 'ok) |
98 | ||
51fa34bc MB |
99 | (defun tq-queue-pop (tq) |
100 | (setcar tq (cdr (car tq))) | |
101 | (let ((question (tq-queue-head-question tq))) | |
5fbd2079 CY |
102 | (condition-case nil |
103 | (process-send-string (tq-process tq) question) | |
104 | (error nil))) | |
51fa34bc | 105 | (null (car tq))) |
a1506d29 | 106 | |
51fa34bc | 107 | (defun tq-enqueue (tq question regexp closure fn &optional delay-question) |
09f11993 RS |
108 | "Add a transaction to transaction queue TQ. |
109 | This sends the string QUESTION to the process that TQ communicates with. | |
51fa34bc MB |
110 | |
111 | When the corresponding answer comes back, we call FN with two | |
112 | arguments: CLOSURE, which may contain additional data that FN | |
113 | needs, and the answer to the question. | |
114 | ||
09f11993 | 115 | REGEXP is a regular expression to match the entire answer; |
51fa34bc MB |
116 | that's how we tell where the answer ends. |
117 | ||
118 | If DELAY-QUESTION is non-nil, delay sending this question until | |
119 | the process has finished replying to any previous questions. | |
120 | This produces more reliable results with some processes." | |
121 | (let ((sendp (or (not delay-question) | |
7a210b69 | 122 | (not (tq-queue tq))))) |
51fa34bc MB |
123 | (tq-queue-add tq (unless sendp question) regexp closure fn) |
124 | (when sendp | |
125 | (process-send-string (tq-process tq) question)))) | |
abeffda9 ER |
126 | |
127 | (defun tq-close (tq) | |
09f11993 | 128 | "Shut down transaction queue TQ, terminating the process." |
abeffda9 ER |
129 | (delete-process (tq-process tq)) |
130 | (kill-buffer (tq-buffer tq))) | |
131 | ||
132 | (defun tq-filter (tq string) | |
133 | "Append STRING to the TQ's buffer; then process the new data." | |
7a210b69 MB |
134 | (let ((buffer (tq-buffer tq))) |
135 | (when (buffer-live-p buffer) | |
136 | (with-current-buffer buffer | |
137 | (goto-char (point-max)) | |
138 | (insert string) | |
139 | (tq-process-buffer tq))))) | |
abeffda9 ER |
140 | |
141 | (defun tq-process-buffer (tq) | |
142 | "Check TQ's buffer for the regexp at the head of the queue." | |
7a210b69 MB |
143 | (let ((buffer (tq-buffer tq))) |
144 | (when (buffer-live-p buffer) | |
145 | (set-buffer buffer) | |
146 | (if (= 0 (buffer-size)) () | |
147 | (if (tq-queue-empty tq) | |
148 | (let ((buf (generate-new-buffer "*spurious*"))) | |
149 | (copy-to-buffer buf (point-min) (point-max)) | |
150 | (delete-region (point-min) (point)) | |
151 | (pop-to-buffer buf nil) | |
152 | (error "Spurious communication from process %s, see buffer %s" | |
153 | (process-name (tq-process tq)) | |
154 | (buffer-name buf))) | |
155 | (goto-char (point-min)) | |
156 | (if (re-search-forward (tq-queue-head-regexp tq) nil t) | |
157 | (let ((answer (buffer-substring (point-min) (point)))) | |
158 | (delete-region (point-min) (point)) | |
159 | (unwind-protect | |
160 | (condition-case nil | |
161 | (funcall (tq-queue-head-fn tq) | |
162 | (tq-queue-head-closure tq) | |
163 | answer) | |
164 | (error nil)) | |
165 | (tq-queue-pop tq)) | |
166 | (tq-process-buffer tq)))))))) | |
abeffda9 | 167 | |
58142744 ER |
168 | (provide 'tq) |
169 | ||
abeffda9 | 170 | ;;; tq.el ends here |