743
|
1 ;;; tq.el --- utility to maintain a transaction queue
|
|
2
|
74466
|
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004,
|
75346
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
841
|
5
|
783
|
6 ;; Author: Scott Draves <spot@cs.cmu.edu>
|
39461
|
7 ;; Maintainer: FSF
|
783
|
8 ;; Adapted-By: ESR
|
814
|
9 ;; Keywords: extensions
|
783
|
10
|
841
|
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
|
78217
|
15 ;; the Free Software Foundation; either version 3, or (at your option)
|
841
|
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
|
14169
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
26 ;; Boston, MA 02110-1301, USA.
|
841
|
27
|
|
28 ;;; Commentary:
|
49598
|
29
|
70034
|
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.
|
743
|
33
|
39568
|
34 ;; Our basic structure is the queue/process/buffer triple. Each entry
|
70034
|
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.
|
743
|
51
|
783
|
52 ;;; Code:
|
743
|
53
|
70034
|
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)))))
|
72548
|
69 ;; closure: additional data to pass to the function
|
70034
|
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
|
1187
|
80 ;;;###autoload
|
743
|
81 (defun tq-create (process)
|
1187
|
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."
|
743
|
86 (let ((tq (cons nil (cons process
|
|
87 (generate-new-buffer
|
|
88 (concat " tq-temp-"
|
|
89 (process-name process)))))))
|
|
90 (set-process-filter process
|
49851
|
91 `(lambda (proc string)
|
52493
|
92 (tq-filter ',tq string)))
|
743
|
93 tq))
|
|
94
|
70034
|
95 (defun tq-queue-add (tq question re closure fn)
|
743
|
96 (setcar tq (nconc (tq-queue tq)
|
70034
|
97 (cons (cons question (cons re (cons closure fn))) nil)))
|
743
|
98 'ok)
|
|
99
|
70034
|
100 (defun tq-queue-pop (tq)
|
|
101 (setcar tq (cdr (car tq)))
|
|
102 (let ((question (tq-queue-head-question tq)))
|
77890
57715561e846
(tq-queue-pop): Stifle error when a process has died and we are trying
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
103 (condition-case nil
|
57715561e846
(tq-queue-pop): Stifle error when a process has died and we are trying
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
104 (process-send-string (tq-process tq) question)
|
57715561e846
(tq-queue-pop): Stifle error when a process has died and we are trying
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
105 (error nil)))
|
70034
|
106 (null (car tq)))
|
49598
|
107
|
70034
|
108 (defun tq-enqueue (tq question regexp closure fn &optional delay-question)
|
1187
|
109 "Add a transaction to transaction queue TQ.
|
|
110 This sends the string QUESTION to the process that TQ communicates with.
|
70034
|
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
|
1187
|
116 REGEXP is a regular expression to match the entire answer;
|
70034
|
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)
|
72548
|
123 (not (tq-queue tq)))))
|
70034
|
124 (tq-queue-add tq (unless sendp question) regexp closure fn)
|
|
125 (when sendp
|
|
126 (process-send-string (tq-process tq) question))))
|
743
|
127
|
|
128 (defun tq-close (tq)
|
1187
|
129 "Shut down transaction queue TQ, terminating the process."
|
743
|
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."
|
72548
|
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)))))
|
743
|
141
|
|
142 (defun tq-process-buffer (tq)
|
|
143 "Check TQ's buffer for the regexp at the head of the queue."
|
72548
|
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))))))))
|
743
|
168
|
841
|
169 (provide 'tq)
|
|
170
|
52401
|
171 ;;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79
|
743
|
172 ;;; tq.el ends here
|