-;;;; Copyright (C) 1996, 1998, 1999 Free Software Foundation, Inc.
-;;;;
+;;;; Copyright (C) 1996, 1998, 1999, 2001 Free Software Foundation, Inc.
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
-;;;;
+;;;;
+;;;; As a special exception, the Free Software Foundation gives permission
+;;;; for additional uses of the text contained in its release of GUILE.
+;;;;
+;;;; The exception is that, if you link the GUILE library with other files
+;;;; to produce an executable, this does not by itself cause the
+;;;; resulting executable to be covered by the GNU General Public License.
+;;;; Your use of that executable is in no way restricted on account of
+;;;; linking the GUILE library code into it.
+;;;;
+;;;; This exception does not however invalidate any other reasons why
+;;;; the executable file might be covered by the GNU General Public License.
+;;;;
+;;;; This exception applies only to the code released by the
+;;;; Free Software Foundation under the name GUILE. If you copy
+;;;; code from other Free Software Foundation releases into a copy of
+;;;; GUILE, as the General Public License permits, the exception does
+;;;; not apply to the code that you add in this way. To avoid misleading
+;;;; anyone as to the status of such modified files, you must delete
+;;;; this exception notice from them.
+;;;;
+;;;; If you write modifications of your own for GUILE, it is your choice
+;;;; whether to permit this exception to apply to your modifications.
+;;;; If you do not wish that, delete this exception notice.
+;;;;
\f
+;;; Commentary:
-(define-module (ice-9 expect) :use-module (ice-9 regex))
+;; This module is documented in the Guile Reference Manual.
+;; Briefly, these are exported:
+;; procedures: expect-select, expect-regexec
+;; variables: expect-port, expect-timeout, expect-timeout-proc,
+;; expect-eof-proc, expect-char-proc,
+;; expect-strings-compile-flags, expect-strings-exec-flags,
+;; macros: expect
+
+;;; Code:
+
+(define-module (ice-9 expect)
+ :use-module (ice-9 regex))
;;; Expect: a macro for selecting actions based on what it reads from a port.
;;; The idea is from Don Libes' expect based on Tcl.
;;; expect: each test is a procedure which is applied to the accumulating
;;; string.
(defmacro-public expect clauses
- (let ((s (gentemp))
- (c (gentemp))
- (port (gentemp))
- (timeout (gentemp)))
+ (let ((s (gensym))
+ (c (gensym))
+ (port (gensym))
+ (timeout (gensym)))
`(let ((,s "")
(,port (or expect-port (current-input-port)))
;; when timeout occurs, in floating point seconds.
#f)))
(let next-char ()
(if (and expect-timeout
- (or (>= (get-internal-real-time) ,timeout)
- (and (not (char-ready? ,port))
- (not (expect-select ,port ,timeout)))))
+ (not (expect-select ,port ,timeout)))
(if expect-timeout-proc
(expect-timeout-proc ,s)
#f)
(if (not (eof-object? ,c))
(set! ,s (string-append ,s (string ,c))))
(cond
- ;; this expands to clauses where the car invokes the match proc and
- ;; the cdr is the return value from expect if the proc matched.
+ ;; this expands to clauses where the car invokes the
+ ;; match proc and the cdr is the return value from expect
+ ;; if the proc matched.
,@(let next-expr ((tests (map car clauses))
(exprs (map cdr clauses))
(body '()))
2))
(scm-error 'misc-error
"expect"
- "bad recipient: %S"
+ "bad recipient: ~S"
(list (car exprs))
#f)
`((apply ,(cadar exprs)
(,(car tests) ,s ,port)))))
- (else
+ (else
(car exprs))))
body)))))
;; if none of the clauses matched the current string.
(cond ((null? tests)
(list (reverse defs) `(expect ,@(reverse body))))
(else
- (let ((rxname (gentemp)))
+ (let ((rxname (gensym)))
(next-test (cdr tests)
(cdr exprs)
(cons `(,rxname (make-regexp
,@(car exprs))
body))))))))
-;;; simplified select: returns #t if input is waiting or #f if timed out.
+;;; simplified select: returns #t if input is waiting or #f if timed out or
+;;; select was interrupted by a signal.
;;; timeout is an absolute time in floating point seconds.
(define-public (expect-select port timeout)
(let* ((secs-usecs (gettimeofday))
- (relative (- timeout
+ (relative (- timeout
(car secs-usecs)
(/ (cdr secs-usecs)
1000000)))) ; one million.
((< i 0) result))
#f)))
+;;; expect.scm ends here
HCoop / bpt / guile.git / blobdiff