From 3428c7a94da5e3b4600639b3c7eb51c884aac449 Mon Sep 17 00:00:00 2001 From: frese Date: Mon, 26 Jul 2004 16:24:58 +0000 Subject: [PATCH] - added output-filtering to interact - based implementation on a functional interface --- scheme/interact.scm | 168 ++++++++++++++++++++++++-------------------- 1 file changed, 91 insertions(+), 77 deletions(-) diff --git a/scheme/interact.scm b/scheme/interact.scm index 532fcfd..9c0e510 100644 --- a/scheme/interact.scm +++ b/scheme/interact.scm @@ -1,81 +1,95 @@ -(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 ...))))) +;; (interact* task [input-filter output-filter]) +;; -;;; 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 (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 () - - ;; 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))))))))) + ((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 ...))))))