annotate lisp/emacs-lisp/tq.el @ 29139:c1c227f62493

(update_charset_table): Accept nil in LONG_NAME and DESCRIPTION. (syms_of_charset): Avoid building same strings.
author Kenichi Handa <handa@m17n.org>
date Wed, 24 May 2000 03:17:37 +0000
parents b48b8060e70d
children d9207f337e2d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1 ;;; tq.el --- utility to maintain a transaction queue
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
3 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
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
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
9 ;; This file is part of GNU Emacs.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
10
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
14 ;; any later version.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
15
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
19 ;; GNU General Public License for more details.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
20
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
21 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11815
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11815
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11815
diff changeset
24 ;; Boston, MA 02111-1307, USA.
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
25
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
26 ;;; Commentary:
783
59dc833c4e0c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 743
diff changeset
27
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28 ;;; manages receiving a stream asynchronously,
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29 ;;; parsing it into transactions, and then calling
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30 ;;; handler functions
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
31
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 ;;; Our basic structure is the queue/process/buffer triple. Each entry
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 ;;; of the queue is a regexp/closure/function triple. We buffer
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 ;;; bytes from the process until we see the regexp at the head of the
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 ;;; queue. Then we call the function with the closure and the
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 ;;; collected bytes.
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37
783
59dc833c4e0c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 743
diff changeset
38 ;;; Code:
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
40 ;;;###autoload
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 (defun tq-create (process)
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
42 "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
43 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
44 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
45 to a tcp server on another machine."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
46 (let ((tq (cons nil (cons process
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 (generate-new-buffer
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 (concat " tq-temp-"
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 (process-name process)))))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 (set-process-filter process
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 (`(lambda (proc string)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52 (tq-filter '(, tq) string))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53 tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55 ;;; accessors
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 (defun tq-queue (tq) (car tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57 (defun tq-process (tq) (car (cdr tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 (defun tq-buffer (tq) (cdr (cdr tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 (defun tq-queue-add (tq re closure fn)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (setcar tq (nconc (tq-queue tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (cons (cons re (cons closure fn)) nil)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 'ok)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65 (defun tq-queue-head-regexp (tq) (car (car (tq-queue tq))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 (defun tq-queue-head-fn (tq) (cdr (cdr (car (tq-queue tq)))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 (defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
68 (defun tq-queue-empty (tq) (not (tq-queue tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 (defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
71
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 ;;; must add to queue before sending!
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 (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
74 "Add a transaction to transaction queue TQ.
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
75 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
76 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
77 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
78 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
79 that's how we tell where the answer ends."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 (tq-queue-add tq regexp closure fn)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 (process-send-string (tq-process tq) question))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83 (defun tq-close (tq)
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
84 "Shut down transaction queue TQ, terminating the process."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
85 (delete-process (tq-process tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86 (kill-buffer (tq-buffer tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88 (defun tq-filter (tq string)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 "Append STRING to the TQ's buffer; then process the new data."
20693
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
90 (with-current-buffer (tq-buffer tq)
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
91 (goto-char (point-max))
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
92 (insert string)
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
93 (tq-process-buffer tq)))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
94
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95 (defun tq-process-buffer (tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 "Check TQ's buffer for the regexp at the head of the queue."
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97 (set-buffer (tq-buffer tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
98 (if (= 0 (buffer-size)) ()
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 (if (tq-queue-empty tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 (let ((buf (generate-new-buffer "*spurious*")))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 (copy-to-buffer buf (point-min) (point-max))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102 (delete-region (point-min) (point))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 (pop-to-buffer buf nil)
14430
408eeedc18cd (tq-process-buffer): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
104 (error "Spurious communication from process %s, see buffer %s"
408eeedc18cd (tq-process-buffer): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
105 (process-name (tq-process tq))
408eeedc18cd (tq-process-buffer): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
106 (buffer-name buf)))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
107 (goto-char (point-min))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108 (if (re-search-forward (tq-queue-head-regexp tq) nil t)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109 (let ((answer (buffer-substring (point-min) (point))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 (delete-region (point-min) (point))
17216
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
111 (unwind-protect
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
112 (condition-case nil
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
113 (funcall (tq-queue-head-fn tq)
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
114 (tq-queue-head-closure tq)
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
115 answer)
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
116 (error nil))
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
117 (tq-queue-pop tq))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
118 (tq-process-buffer tq))))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
120 (provide 'tq)
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
121
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
122 ;;; tq.el ends here