scsh-expect/scheme/interact.scm

;; (interact* task [input-filter output-filter])
;; 

(define (interact* task . args)
  (let-optionals args ((input-filter (lambda (k x) x))
		       (output-filter (lambda (k x) x)))
     (let ((ivec (make-vector 2))
	   (ivec0 (current-input-port))
	   (ivec1 (task:in task))
	   (out0 (current-output-port))
	   (out1 (task:out task)))
       (call-with-current-continuation
	(lambda (k)
	  (with-errno-handler
	   ((e p) ((errno/io) #f)) ;; TODO: eof in input/output
	   (let lp ()
	     (vector-set! ivec 0 ivec0)
	     (vector-set! ivec 1 ivec1)
	     (select! ivec '#() '#())
	     (if (char-ready? ivec0)
		 (let ((str (input-filter k (read-string/partial 256 ivec0))))
		   (if str (write-string str out1))))
	     (if (char-ready? ivec1)
		 (let ((str (output-filter k (read-string/partial 256 ivec1))))
		   (if str (write-string str out0))))
	     (lp))))))))

(define (interact/char* task . args)
  (let-optionals args ((input-filter #f)
		       (output-filter #f))
    (interact* task
	       (lambda (k str)
		 (if input-filter
		     ;; TODO: does this preserve correct order?
		     (let ((chars (filter (lambda (c) (input-filter k c))
					  (string->list str))))
		       (list->string chars))
		     str))
	       (lambda (k str)
		 (if output-filter
		     (let ((chars (filter (lambda (c) (output-filter k c))
					  (string->list str))))
		       (list->string chars))
		     str)))))

;; syntax
;;;; 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-input-clauses
  (syntax-rules (filter eof)
    ((interact-input-clauses break char)
     #t)
    ((interact-input-clauses break char (eof k body ...) clause2 ...)
     (if (eof-object? char)
	 (let ((k break))
	   (begin body ...))
	 (interact-input-clauses break char clause2 ...)))
    ((interact-input-clauses break char (test-char k body ...) clause2 ...)
     (if (eq? char test-char)
	 (let ((k break))
	   (begin body ...))
	 (interact-input-clauses break char clause2 ...)))
    ((interact-input-clauses break char (filter proc) clause2 ...)
     (and (filter break char)
	  (interact-input-clauses break char clause2 ...)))))

(define-syntax interact-output-clauses
  (syntax-rules (filter eof)
    ((interact-output-clauses break char)
     #t)
    ((interact-output-clauses break char clause ...)
     #t)))

(define-syntax interact
  (syntax-rules ()
    ((interact task)
     (interact* task))
    ((interact task clause ...)
     (interact/char* task
		     (lambda (k c)
		       (interact-input-clauses k c clause ...))
		     (lambda (k c)
		       (interact-output-clauses k c clause ...))))))