(define-syntax interact-clause-test
  (syntax-rules (filter eof)
    ((interact-clause-test char break) #t)
    ((interact-clause-test eof break (eof body ...) clause2 ...)
     (begin body ...))
    ((interact-clause-test eof break clause1 clause2 ...)
     (interact-clause-test eof break clause2 ...))
    ((interact-clause-test char break (eof body ...) clause2 ...)
     (interact-clause-test char break clause2 ...))
    ((interact-clause-test char break (filter filter-proc) clause2 ...)
     (and (filter-proc char break)
          (interact-clause-test char break clause2 ...)))
    ((interact-clause-test char break (test-char k body ...) clause2 ...)
     (if (eq? char test-char) 
         (and (let ((k break)) body ...)
              (interact-clause-test char break clause2 ...))
         (interact-clause-test char break clause2 ...)))))

;;; Allow user to interact with program (sometimes there's just no other way)
;;; (interact task) simply switches the user into interact mode with the task.
;;; 
;;; (interact task clause ...) filters the input.  The clause can either be a
;;; character clause (character continuation-variable exp ...) or a filter
;;; clause (filter proc).  A character clause matches the character given,
;;; links the continuation variable to the continuation out of the
;;; interaction, and runs the expressions.  A filter clause runs the given
;;; filter-function with two arguments: the character entered and the
;;; continuation out of the interaction.  In both cases, if the filter returns
;;; true, the expression falls through.  If the expression falls through to
;;; the bottom, the character is printed.  Note that the interaction will
;;; continue anyway, unless the continuation was explicitly called.

(define-syntax interact
  (syntax-rules ()

    ;; If there is just one argument, simply enable transfer.
    ((interact with)
     (call-with-current-continuation 
      (lambda (break)
        (let ((ivec (make-vector 2))
              (ivec0 (current-input-port))
              (ivec1 (task:in with)))
          (with-errno-handler ((e p) ((errno/io) #f))
            (let lp ()
              (vector-set! ivec 0 ivec0)
              (vector-set! ivec 1 ivec1)
              (select! ivec '#() '#())
              (if (char-ready? ivec0)
                  (write-string (read-string/partial 256 ivec0) 
                                (task:out with)))
              (if (char-ready? ivec1)
                  (write-string (read-string/partial 256 ivec1)))
              (lp)))))))

    ;; If there is more than one argument,
    ;;enable transfer and allow escape keys.
    ((interact with clauses ...)
     (call-with-current-continuation
      (lambda (break)
        (let ((ivec (make-vector 2))
              (ivec0 (current-input-port))
              (ivec1 (task:in with)))
          (with-errno-handler ((e p)
                               ((errno/io)
                                (interact-clause-test eof #f clauses ...)))
            (let lp ()
              (vector-set! ivec 0 ivec0)
              (vector-set! ivec 1 ivec1)
              (select! ivec '#() '#())
              (if (char-ready? (current-input-port))
                  (for-each (lambda (transfer)
                              ;; Test for indicated escape keys.
                              (and (interact-clause-test transfer break
                                                         clauses ...)
                                   ;; Only write if all clauses "fell through"
                                   (write-char transfer (task:out with))))
                            (string->list (read-string/partial 256 (current-inpu
t-port)))))
              (if (char-ready? (task:in with))
                  (write-string (read-string/partial 256 (task:in with))))
              (lp)))))))))