743
|
1 ;;; tq.el --- utility to maintain a transaction queue
|
|
2
|
|
3 ;;; Copyright (C) 1992 Scott Draves (spot@cs.cmu.edu)
|
|
4 ;;;
|
|
5 ;;; manages receiving a stream asynchronously,
|
|
6 ;;; parsing it into transactions, and then calling
|
|
7 ;;; handler functions
|
|
8
|
|
9
|
|
10 ;;; Our basic structure is the queue/process/buffer triple. Each entry
|
|
11 ;;; of the queue is a regexp/closure/function triple. We buffer
|
|
12 ;;; bytes from the process until we see the regexp at the head of the
|
|
13 ;;; queue. Then we call the function with the closure and the
|
|
14 ;;; collected bytes.
|
|
15
|
|
16
|
|
17 (provide 'tq)
|
|
18
|
|
19 (defun tq-create (process)
|
|
20 "Create and return a transaction queue. PROCESS should be capable
|
|
21 of sending and receiving streams of bytes. It may be a local process,
|
|
22 or it may be connected to a tcp server on another machine."
|
|
23 (let ((tq (cons nil (cons process
|
|
24 (generate-new-buffer
|
|
25 (concat " tq-temp-"
|
|
26 (process-name process)))))))
|
|
27 (set-process-filter process
|
|
28 (`(lambda (proc string)
|
|
29 (tq-filter '(, tq) string))))
|
|
30 tq))
|
|
31
|
|
32 ;;; accessors
|
|
33 (defun tq-queue (tq) (car tq))
|
|
34 (defun tq-process (tq) (car (cdr tq)))
|
|
35 (defun tq-buffer (tq) (cdr (cdr tq)))
|
|
36
|
|
37 (defun tq-queue-add (tq re closure fn)
|
|
38 (setcar tq (nconc (tq-queue tq)
|
|
39 (cons (cons re (cons closure fn)) nil)))
|
|
40 'ok)
|
|
41
|
|
42 (defun tq-queue-head-regexp (tq) (car (car (tq-queue tq))))
|
|
43 (defun tq-queue-head-fn (tq) (cdr (cdr (car (tq-queue tq)))))
|
|
44 (defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
|
|
45 (defun tq-queue-empty (tq) (not (tq-queue tq)))
|
|
46 (defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq)))
|
|
47
|
|
48
|
|
49 ;;; must add to queue before sending!
|
|
50 (defun tq-enqueue (tq question regexp closure fn)
|
|
51 "Add a transaction to TQ. Send question to the process, and call FN
|
|
52 with CLOSURE and and the answer, when it appears. The end of the
|
|
53 answer is identified by REGEXP."
|
|
54 (tq-queue-add tq regexp closure fn)
|
|
55 (process-send-string (tq-process tq) question))
|
|
56
|
|
57 (defun tq-close (tq)
|
|
58 "Shut down the process, and destroy the evidence."
|
|
59 (delete-process (tq-process tq))
|
|
60 (kill-buffer (tq-buffer tq)))
|
|
61
|
|
62 (defun tq-filter (tq string)
|
|
63 "Append STRING to the TQ's buffer; then process the new data."
|
|
64 (set-buffer (tq-buffer tq))
|
|
65 (goto-char (point-max))
|
|
66 (insert string)
|
|
67 (tq-process-buffer tq))
|
|
68
|
|
69 (defun tq-process-buffer (tq)
|
|
70 "Check TQ's buffer for the regexp at the head of the queue."
|
|
71 (set-buffer (tq-buffer tq))
|
|
72 (if (= 0 (buffer-size)) ()
|
|
73 (if (tq-queue-empty tq)
|
|
74 (let ((buf (generate-new-buffer "*spurious*")))
|
|
75 (copy-to-buffer buf (point-min) (point-max))
|
|
76 (delete-region (point-min) (point))
|
|
77 (pop-to-buffer buf nil)
|
|
78 (error (concat "Spurious communication from process "
|
|
79 (process-name (tq-process tq))
|
|
80 ", see buffer *spurious*.")))
|
|
81 (goto-char (point-min))
|
|
82 (if (re-search-forward (tq-queue-head-regexp tq) nil t)
|
|
83 (let ((answer (buffer-substring (point-min) (point))))
|
|
84 (delete-region (point-min) (point))
|
|
85 (funcall (tq-queue-head-fn tq)
|
|
86 (tq-queue-head-closure tq)
|
|
87 answer)
|
|
88 (tq-queue-pop tq)
|
|
89 (tq-process-buffer tq))))))
|
|
90
|
|
91 ;;; tq.el ends here
|