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