Mercurial > emacs
annotate lisp/emacs-lisp/tq.el @ 8518:44ff33b29c3e
(one-window-p): Doc fix.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 11 Aug 1994 20:25:20 +0000 |
parents | 519c04d69cdc |
children | e8214d59e98d |
rev | line source |
---|---|
743 | 1 ;;; tq.el --- utility to maintain a transaction queue |
2 | |
841 | 3 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
4 | |
783
59dc833c4e0c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
743
diff
changeset
|
5 ;; Author: Scott Draves <spot@cs.cmu.edu> |
59dc833c4e0c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
743
diff
changeset
|
6 ;; Adapted-By: ESR |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
783
diff
changeset
|
7 ;; Keywords: extensions |
783
59dc833c4e0c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
743
diff
changeset
|
8 |
841 | 9 ;; This file is part of GNU Emacs. |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
25 ;;; Commentary: | |
783
59dc833c4e0c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
743
diff
changeset
|
26 |
743 | 27 ;;; manages receiving a stream asynchronously, |
28 ;;; parsing it into transactions, and then calling | |
29 ;;; handler functions | |
30 | |
31 ;;; Our basic structure is the queue/process/buffer triple. Each entry | |
32 ;;; of the queue is a regexp/closure/function triple. We buffer | |
33 ;;; bytes from the process until we see the regexp at the head of the | |
34 ;;; queue. Then we call the function with the closure and the | |
35 ;;; collected bytes. | |
36 | |
783
59dc833c4e0c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
743
diff
changeset
|
37 ;;; Code: |
743 | 38 |
1187
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
39 ;;;###autoload |
743 | 40 (defun tq-create (process) |
1187
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
41 "Create and return a transaction queue communicating with PROCESS. |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
42 PROCESS should be a subprocess capable of sending and receiving |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
43 streams of bytes. It may be a local process, or it may be connected |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
44 to a tcp server on another machine." |
743 | 45 (let ((tq (cons nil (cons process |
46 (generate-new-buffer | |
47 (concat " tq-temp-" | |
48 (process-name process))))))) | |
49 (set-process-filter process | |
50 (`(lambda (proc string) | |
51 (tq-filter '(, tq) string)))) | |
52 tq)) | |
53 | |
54 ;;; accessors | |
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 (defun tq-queue-add (tq re closure fn) | |
60 (setcar tq (nconc (tq-queue tq) | |
61 (cons (cons re (cons closure fn)) nil))) | |
62 'ok) | |
63 | |
64 (defun tq-queue-head-regexp (tq) (car (car (tq-queue tq)))) | |
65 (defun tq-queue-head-fn (tq) (cdr (cdr (car (tq-queue tq))))) | |
66 (defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq))))) | |
67 (defun tq-queue-empty (tq) (not (tq-queue tq))) | |
68 (defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq))) | |
69 | |
70 | |
71 ;;; must add to queue before sending! | |
72 (defun tq-enqueue (tq question regexp closure fn) | |
1187
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
73 "Add a transaction to transaction queue TQ. |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
74 This sends the string QUESTION to the process that TQ communicates with. |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
75 When the corresponding answer comes back, we call FN |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
76 with two arguments: CLOSURE, and the answer to the question. |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
77 REGEXP is a regular expression to match the entire answer; |
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
78 that's how we tell where the answer ends." |
743 | 79 (tq-queue-add tq regexp closure fn) |
80 (process-send-string (tq-process tq) question)) | |
81 | |
82 (defun tq-close (tq) | |
1187
519c04d69cdc
Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents:
841
diff
changeset
|
83 "Shut down transaction queue TQ, terminating the process." |
743 | 84 (delete-process (tq-process tq)) |
85 (kill-buffer (tq-buffer tq))) | |
86 | |
87 (defun tq-filter (tq string) | |
88 "Append STRING to the TQ's buffer; then process the new data." | |
89 (set-buffer (tq-buffer tq)) | |
90 (goto-char (point-max)) | |
91 (insert string) | |
92 (tq-process-buffer tq)) | |
93 | |
94 (defun tq-process-buffer (tq) | |
95 "Check TQ's buffer for the regexp at the head of the queue." | |
96 (set-buffer (tq-buffer tq)) | |
97 (if (= 0 (buffer-size)) () | |
98 (if (tq-queue-empty tq) | |
99 (let ((buf (generate-new-buffer "*spurious*"))) | |
100 (copy-to-buffer buf (point-min) (point-max)) | |
101 (delete-region (point-min) (point)) | |
102 (pop-to-buffer buf nil) | |
103 (error (concat "Spurious communication from process " | |
104 (process-name (tq-process tq)) | |
105 ", see buffer *spurious*."))) | |
106 (goto-char (point-min)) | |
107 (if (re-search-forward (tq-queue-head-regexp tq) nil t) | |
108 (let ((answer (buffer-substring (point-min) (point)))) | |
109 (delete-region (point-min) (point)) | |
110 (funcall (tq-queue-head-fn tq) | |
111 (tq-queue-head-closure tq) | |
112 answer) | |
113 (tq-queue-pop tq) | |
114 (tq-process-buffer tq)))))) | |
115 | |
841 | 116 (provide 'tq) |
117 | |
743 | 118 ;;; tq.el ends here |