home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / gnus-xover-1.2 / chat.el next >
Encoding:
Text File  |  1993-04-16  |  7.3 KB  |  212 lines
  1. ;;;;;;;;;;;;;;;;
  2. ;;; chat - A method for talking to asynchronous processes.
  3.  
  4. ;; $Id: chat.el,v 1.7 1993/02/05 01:49:31 flee Exp $
  5.  
  6. (provide 'chat)
  7. (require 'backquote)
  8.  
  9. ;; Data from an asynchronous process gets appended to the process's
  10. ;; buffer as soon as it's available.
  11.  
  12. ;; The data may come in pieces smaller than the units a caller wants
  13. ;; to deal with, so here are functions that wait for conditions, like
  14. ;; receiving a particular string, or receiving N bytes.
  15.  
  16. ;; The functions also keep a caller from seeing more data than it
  17. ;; wants: each process buffer has a data mark that keeps track of how
  18. ;; much of the buffer has actually been waited for.
  19.  
  20. ;; A typical use is:
  21. ;;    (chat/with-data-until-string "\n" proc
  22. ;;      (buffer-substring (point-min) (1- (point-max))))
  23. ;; which waits until we receive a line of text, and returns the line
  24. ;; without the "\n".
  25.  
  26. ;; XXX It would be nice if we could provide timeouts for waiting on
  27. ;; data, but this is really awkward to do.
  28.  
  29. ;; XXX There's something that's not quite right about this module; but
  30. ;; let's run with it for a little while and see what happens.
  31.  
  32. ;; XXX point in the process buffer is left alone, up to the caller to
  33. ;; modify.  Maybe it should always be set to the beginning of input?
  34.  
  35. ;;;;;;;;;;;;;;;;
  36. ;;; The data mark.
  37.  
  38. (defvar chat/data-marker nil
  39.   "A buffer's data marker.")
  40. (make-variable-buffer-local 'chat/data-marker)
  41.  
  42. (defmacro chat/set-data-marker (location)
  43.   "Set the current buffer's data marker to LOCATION.  Returns the data
  44. marker."
  45.   (` (set-marker
  46.       (if (markerp chat/data-marker)
  47.       chat/data-marker
  48.     (setq chat/data-marker (make-marker)))
  49.       (, location))))
  50.  
  51. ;;;;;;;;;;;;;;;;
  52. ;;; Waiting for data.
  53.  
  54. ;; XXX Need to add some comments on efficiency.
  55. ;; wait-for-length is linear,
  56. ;; wait-for-string is rectangular,
  57. ;; wait-for-regexp is quadratic or worse,
  58. ;; wait-for-dot-crlf is linear.
  59.  
  60. ;; This is the error that's signalled when you try to chat with a
  61. ;; process that's gone.
  62. (put 'no-process 'error-conditions '(error no-process))
  63. (put 'no-process 'error-message "Connection is broken")
  64.  
  65. (defmacro chat/with-buffer-of (proc &rest forms)
  66.   "Set the current buffer to PROC's buffer, and evaluate FORMS."
  67.   (` (save-excursion
  68.        (set-buffer (process-buffer (, proc)))
  69.        (,@ forms))))
  70. (put 'chat/with-buffer-of 'lisp-indent-hook 1)
  71.  
  72. ;; XXX should we consider stopped processes as runnable?
  73. (defmacro chat/accept-from (proc)
  74.   (` (if (memq (process-status (, proc)) '(open run))
  75.      (accept-process-output (, proc))
  76.        (signal 'no-process (, proc)))))
  77.  
  78. (defun chat/wait-for-length (size proc)
  79.   "Wait until we have SIZE characters of data from PROC.  When
  80. successful, returns true and sets PROC's data mark to the location
  81. after SIZE.  Does not change the match data.  Signals 'no-process if
  82. PROC has died."
  83.   (chat/with-buffer-of proc
  84.     (while (< (point-max) (+ (point-min) size))
  85.       (chat/accept-from proc))
  86.     (chat/set-data-marker (+ (point-min) size))))
  87.  
  88. (defun chat/wait-for-string (string proc)
  89.   "Wait until we see STRING in PROC's data.  When successful, returns
  90. true and sets PROC's data mark to the end of the STRING match.  Also
  91. sets the match data.  Signals 'no-process if PROC has died."
  92.   (chat/with-buffer-of proc
  93.     (goto-char (point-min))
  94.     (while (not (search-forward string nil 'eob))
  95.       ;; This mess is mostly because 'accept-process-output does nasty
  96.       ;; things to point.
  97.       (goto-char (prog1 (- (point) (length string))
  98.            (chat/accept-from proc))))
  99.     (chat/set-data-marker (point))))
  100.  
  101. (defun chat/wait-for-regexp (regexp proc)
  102.   "Wait until we see REGEXP in PROC's data.  When successful, returns
  103. true and sets PROC's data mark to the end of the REGEXP match.  Also
  104. sets the match data.  Signals 'no-process if PROC has died."
  105.   (chat/with-buffer-of proc
  106.     (save-excursion
  107.       (goto-char (point-min))
  108.       (while (not (re-search-forward regexp nil t))
  109.     (chat/accept-from proc)
  110.     ;; We can't optimize the next search, because we don't know
  111.     ;; anything about what the regexp won't match.
  112.     (goto-char (point-min)))
  113.       (chat/set-data-marker (point)))))
  114.  
  115. (defun chat/wait-for-dot-crlf (proc)
  116.   "The same as (chat/wait-for-regexp \"^\\\\.\\r\\n\" PROC), but
  117. considerably faster."
  118.   (chat/with-buffer-of proc
  119.     (save-excursion
  120.       (goto-char (point-min))
  121.       (if (not (looking-at ".\r?\n"))
  122.       (while (not (and (search-forward "\n." nil 'eob)
  123.                (looking-at "\r?\n")))
  124.         (if (eobp)
  125.         ;; This mess is mainly because 'accept-process-output
  126.         ;; does nasty things with point.
  127.         (goto-char (prog1 (- (point) 3)
  128.                  (chat/accept-from proc))))))
  129.       (forward-line)
  130.       (chat/set-data-marker (point)))))
  131.  
  132. ;;;;;;;;;;;;;;;;
  133. ;;; Processing the data.
  134.  
  135. (defmacro chat/with-data-of (proc &rest forms)
  136.   "Set the current buffer to PROC's buffer, narrowed to the region up
  137. to PROC's data mark, and evaluate FORMS.  And then the data up to the
  138. data mark is deleted.  Returns the value of FORMS.
  139.  
  140. If you discover you didn't really need all the data and want to push
  141. some back, use 'chat/set-data-marker to change the data mark.  Or
  142. consider using 'chat/with-buffer-of instead."
  143.   (` (chat/with-buffer-of (, proc)
  144.        (prog1
  145.        (save-restriction
  146.          (narrow-to-region (point-min) chat/data-marker)
  147.          (,@ forms))
  148.      (delete-region (point-min) chat/data-marker)))))
  149. (put 'chat/with-data-of 'lisp-indent-hook 1)
  150.  
  151. (defun chat/data-of (proc)
  152.   "Returns a string that contains PROC's data up to its data mark, and
  153. deletes the data.  If you need to do any parsing, you probably want to
  154. be using 'chat/with-data-of instead."
  155.   (chat/with-data-of proc
  156.     (prog1 (buffer-string)
  157.       (delete-region (point-min) (point-max)))))
  158.  
  159. (defun chat/delete-pending-data (proc)
  160.   "Clear out as much of PROC's pending data that we can without
  161. blocking.  Returns nothing."
  162.   (chat/with-buffer-of proc
  163.     (widen)
  164.     (while (< (point-min) (point-max))
  165.       (delete-region (point-min) (point-max))
  166.       (accept-process-output))))
  167.  
  168. ;;;;;;;;;;;;;;;;
  169. ;;; Waiting and processing.
  170.  
  171. ;; XXX factor the expansions of these routines for efficiency?
  172.  
  173. (defmacro chat/with-data-for-length (length proc &rest forms)
  174.   "(LENGTH PROC FORMS ...).  Equivalent to
  175.     (chat/wait-for-length LENGTH PROC)
  176.     (chat/with-data-of PROC FORMS ...)
  177. "
  178.   (` (progn
  179.        (chat/wait-for-length (, length) (, proc))
  180.        (chat/with-data-of (, proc) (,@ forms)))))
  181. (put 'chat/with-data-for-length 'lisp-indent-hook 2)
  182.  
  183. (defmacro chat/with-data-until-string (string proc &rest forms)
  184.   "(STRING PROC FORMS ...).  Equivalent to
  185.     (chat/wait-for-string STRING PROC)
  186.     (chat/with-data-of PROC FORMS ...)
  187. "
  188.   (` (progn
  189.        (chat/wait-for-string (, string) (, proc))
  190.        (chat/with-data-of (, proc) (,@ forms)))))
  191. (put 'chat/with-data-until-string 'lisp-indent-hook 2)
  192.  
  193. (defmacro chat/with-data-until-regexp (regexp proc &rest forms)
  194.   "(REGEXP PROC FORMS ...).  Equivalent to
  195.     (chat/wait-for-regexp REGEXP PROC)
  196.     (chat/with-data-of PROC FORMS ...)
  197. "
  198.   (` (progn
  199.        (chat/wait-for-regexp (, regexp) (, proc))
  200.        (chat/with-data-of (, proc) (,@ forms)))))
  201. (put 'chat/with-data-until-regexp 'lisp-indent-hook 2)
  202.  
  203. (defmacro chat/with-data-until-dot-crlf (proc &rest forms)
  204.   "(PROC FORMS ...).  Equivalent to
  205.     (chat/wait-for-dot-crlf PROC)
  206.     (chat/with-data-of PROC FORMS ...)
  207. "
  208.   (` (progn
  209.        (chat/wait-for-dot-crlf (, proc))
  210.        (chat/with-data-of (, proc) (,@ forms)))))
  211. (put 'chat/with-data-until-dot-crlf 'lisp-indent-hook 1)
  212.