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