lisp/emacs-lisp/tq.el

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