1;;; tq.el --- utility to maintain a transaction queue 2 3;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Scott Draves <spot@cs.cmu.edu> 7;; Maintainer: FSF 8;; Adapted-By: ESR 9;; Keywords: extensions 10 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 15;; the Free Software Foundation; either version 2, or (at your option) 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 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 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. 33 34;; Our basic structure is the queue/process/buffer triple. Each entry 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. 51 52;;; Code: 53 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))))) 69;; closure: additional data to pass to the function 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 80;;;###autoload 81(defun tq-create (process) 82 "Create and return a transaction queue communicating with PROCESS. 83PROCESS should be a subprocess capable of sending and receiving 84streams of bytes. It may be a local process, or it may be connected 85to a tcp server on another machine." 86 (let ((tq (cons nil (cons process 87 (generate-new-buffer 88 (concat " tq-temp-" 89 (process-name process))))))) 90 (set-process-filter process 91 `(lambda (proc string) 92 (tq-filter ',tq string))) 93 tq)) 94 95(defun tq-queue-add (tq question re closure fn) 96 (setcar tq (nconc (tq-queue tq) 97 (cons (cons question (cons re (cons closure fn))) nil))) 98 'ok) 99 100(defun tq-queue-pop (tq) 101 (setcar tq (cdr (car tq))) 102 (let ((question (tq-queue-head-question tq))) 103 (when question 104 (process-send-string (tq-process tq) question))) 105 (null (car tq))) 106 107(defun tq-enqueue (tq question regexp closure fn &optional delay-question) 108 "Add a transaction to transaction queue TQ. 109This sends the string QUESTION to the process that TQ communicates with. 110 111When the corresponding answer comes back, we call FN with two 112arguments: CLOSURE, which may contain additional data that FN 113needs, and the answer to the question. 114 115REGEXP is a regular expression to match the entire answer; 116that's how we tell where the answer ends. 117 118If DELAY-QUESTION is non-nil, delay sending this question until 119the process has finished replying to any previous questions. 120This produces more reliable results with some processes." 121 (let ((sendp (or (not delay-question) 122 (not (tq-queue tq))))) 123 (tq-queue-add tq (unless sendp question) regexp closure fn) 124 (when sendp 125 (process-send-string (tq-process tq) question)))) 126 127(defun tq-close (tq) 128 "Shut down transaction queue TQ, terminating the process." 129 (delete-process (tq-process tq)) 130 (kill-buffer (tq-buffer tq))) 131 132(defun tq-filter (tq string) 133 "Append STRING to the TQ's buffer; then process the new data." 134 (let ((buffer (tq-buffer tq))) 135 (when (buffer-live-p buffer) 136 (with-current-buffer buffer 137 (goto-char (point-max)) 138 (insert string) 139 (tq-process-buffer tq))))) 140 141(defun tq-process-buffer (tq) 142 "Check TQ's buffer for the regexp at the head of the queue." 143 (let ((buffer (tq-buffer tq))) 144 (when (buffer-live-p buffer) 145 (set-buffer buffer) 146 (if (= 0 (buffer-size)) () 147 (if (tq-queue-empty tq) 148 (let ((buf (generate-new-buffer "*spurious*"))) 149 (copy-to-buffer buf (point-min) (point-max)) 150 (delete-region (point-min) (point)) 151 (pop-to-buffer buf nil) 152 (error "Spurious communication from process %s, see buffer %s" 153 (process-name (tq-process tq)) 154 (buffer-name buf))) 155 (goto-char (point-min)) 156 (if (re-search-forward (tq-queue-head-regexp tq) nil t) 157 (let ((answer (buffer-substring (point-min) (point)))) 158 (delete-region (point-min) (point)) 159 (unwind-protect 160 (condition-case nil 161 (funcall (tq-queue-head-fn tq) 162 (tq-queue-head-closure tq) 163 answer) 164 (error nil)) 165 (tq-queue-pop tq)) 166 (tq-process-buffer tq)))))))) 167 168(provide 'tq) 169 170;;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79 171;;; tq.el ends here 172