annotate lisp/emacs-lisp/tq.el @ 61931:f3e1b2ceffd2

Improve commentary section. (define-generic-mode): Improve docstring.
author Lute Kamstra <lute@gnu.org>
date Fri, 29 Apr 2005 13:12:26 +0000
parents 04f194e85b4d
children 18a818a2ee7c
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
52493
04f194e85b4d (tq-create): Fix mixed up unquote style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52401
diff changeset
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 2003 Free Software Foundation, Inc.
841
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>
39461
d9207f337e2d Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20693
diff changeset
6 ;; Maintainer: FSF
783
59dc833c4e0c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 743
diff changeset
7 ;; Adapted-By: ESR
814
38b2499cb3e9 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 783
diff changeset
8 ;; Keywords: extensions
783
59dc833c4e0c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 743
diff changeset
9
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
10 ;; This file is part of GNU Emacs.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
11
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
12 ;; 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
13 ;; 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
14 ;; 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
15 ;; any later version.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
16
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
17 ;; 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
18 ;; 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
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
20 ;; GNU General Public License for more details.
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
21
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
22 ;; 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
23 ;; 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
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11815
diff changeset
25 ;; Boston, MA 02111-1307, USA.
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
26
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
27 ;;; Commentary:
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 39568
diff changeset
28
39568
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
29 ;; manages receiving a stream asynchronously,
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
30 ;; parsing it into transactions, and then calling
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
31 ;; handler functions
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32
39568
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
33 ;; Our basic structure is the queue/process/buffer triple. Each entry
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
34 ;; of the queue is a regexp/closure/function triple. We buffer
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
35 ;; bytes from the process until we see the regexp at the head of the
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
36 ;; queue. Then we call the function with the closure and the
e67950065cf9 Change ;;; to ;; for outline-minor-mode.
Gerd Moellmann <gerd@gnu.org>
parents: 39461
diff changeset
37 ;; collected bytes.
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38
783
59dc833c4e0c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 743
diff changeset
39 ;;; Code:
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
41 ;;;###autoload
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 (defun tq-create (process)
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
43 "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
44 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
45 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
46 to a tcp server on another machine."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 (let ((tq (cons nil (cons process
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 (generate-new-buffer
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 (concat " tq-temp-"
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 (process-name process)))))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 (set-process-filter process
49851
fec321336b72 (tq-create): Fix quoted lambda.
Juanma Barranquero <lekktu@gmail.com>
parents: 49598
diff changeset
52 `(lambda (proc string)
52493
04f194e85b4d (tq-create): Fix mixed up unquote style.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52401
diff changeset
53 (tq-filter ',tq string)))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54 tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 ;;; accessors
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57 (defun tq-queue (tq) (car tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 (defun tq-process (tq) (car (cdr tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 (defun tq-buffer (tq) (cdr (cdr tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (defun tq-queue-add (tq re closure fn)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (setcar tq (nconc (tq-queue tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 (cons (cons re (cons closure fn)) nil)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64 'ok)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 (defun tq-queue-head-regexp (tq) (car (car (tq-queue tq))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 (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
68 (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
69 (defun tq-queue-empty (tq) (not (tq-queue tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70 (defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 39568
diff changeset
71
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 ;;; must add to queue before sending!
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 (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
75 "Add a transaction to transaction queue TQ.
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
76 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
77 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
78 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
79 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
80 that's how we tell where the answer ends."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 (tq-queue-add tq regexp closure fn)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82 (process-send-string (tq-process tq) question))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
84 (defun tq-close (tq)
1187
519c04d69cdc Doc fixes. Make tq-create autoload.
Richard M. Stallman <rms@gnu.org>
parents: 841
diff changeset
85 "Shut down transaction queue TQ, terminating the process."
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86 (delete-process (tq-process tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87 (kill-buffer (tq-buffer tq)))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 (defun tq-filter (tq string)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
90 "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
91 (with-current-buffer (tq-buffer tq)
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
92 (goto-char (point-max))
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
93 (insert string)
b48b8060e70d (tq-filter): Use with-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 17216
diff changeset
94 (tq-process-buffer tq)))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 (defun tq-process-buffer (tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97 "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
98 (set-buffer (tq-buffer tq))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 (if (= 0 (buffer-size)) ()
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 (if (tq-queue-empty tq)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 (let ((buf (generate-new-buffer "*spurious*")))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102 (copy-to-buffer buf (point-min) (point-max))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 (delete-region (point-min) (point))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
104 (pop-to-buffer buf nil)
14430
408eeedc18cd (tq-process-buffer): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
105 (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
106 (process-name (tq-process tq))
408eeedc18cd (tq-process-buffer): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
107 (buffer-name buf)))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108 (goto-char (point-min))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109 (if (re-search-forward (tq-queue-head-regexp tq) nil t)
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 (let ((answer (buffer-substring (point-min) (point))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
111 (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
112 (unwind-protect
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
113 (condition-case nil
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
114 (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
115 (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
116 answer)
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
117 (error nil))
ef3033d89075 (tq-process-buffer): Catch errors running tq-queue-head-fn.
Richard M. Stallman <rms@gnu.org>
parents: 16235
diff changeset
118 (tq-queue-pop tq))
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119 (tq-process-buffer tq))))))
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
120
841
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
121 (provide 'tq)
2cdce064065f entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
122
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49851
diff changeset
123 ;;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79
743
4c88459587e3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 ;;; tq.el ends here