scsh-expect/scheme/interact.scm

96 lines
3.4 KiB
Scheme
Raw Normal View History

;; (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 ...))))))