diff --git a/scsh/tty.scm b/scsh/tty.scm index cf8327c..1fc2684 100644 --- a/scsh/tty.scm +++ b/scsh/tty.scm @@ -100,7 +100,8 @@ (define (sleazy-call/file tty opener proc) - (if (string? tty) (opener tty proc) + (if (string? tty) + (opener tty (lambda (port) (sleazy-call/fdes port proc))) (sleazy-call/fdes tty proc))) ;;; (tty-info [fd/port/fname]) @@ -121,7 +122,9 @@ (decode-baud-rate ospeed-code) ospeed-code (char->ascii (string-ref control-chars ttychar/min)) (char->ascii (string-ref control-chars ttychar/time)))) - (sleazy-call/fdes fdport (lambda (fd) (%tty-info fd control-chars)))))) + (sleazy-call/file fdport + call-with-input-file + (lambda (fd) (%tty-info fd control-chars)))))) (import-os-error-syscall %tty-info (fdes control-chars) "scheme_tcgetattr") @@ -168,8 +171,9 @@ (cc (tty-info:control-chars info)) (is (%tty-info:input-speed-code info)) (os (%tty-info:output-speed-code info))) - (sleazy-call/fdes + (sleazy-call/file fdport + call-with-input-file (lambda (fd) (%set-tty-info fd option cc @@ -203,10 +207,12 @@ ;;; Send a break on the serial line. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (send-tty-break fdport . maybe-duration) - (sleazy-call/fdes fdport - (lambda (fdes) - (%send-tty-break-fdes fdes (:optional maybe-duration 0))))) +(define (send-tty-break . args) + (let-optionals args ((tty (current-output-port)) + (duration 0)) + (sleazy-call/file tty call-with-output-file + (lambda (fdes) + (%send-tty-break-fdes fdes duration))))) (import-os-error-syscall %send-tty-break-fdes (fdes duration) "sch_tcsendbreak") @@ -214,12 +220,15 @@ ;;; Drain the main vein. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (drain-tty fdport) - (cond ((integer? fdport) (%tcdrain fdport)) ; File descriptor. - ((fdport? fdport) ; Scheme port -- flush first. - (force-output fdport) - (sleazy-call/fdes fdport %tcdrain)) - (else (error "Illegal argument to DRAIN-TTY" fdport)))) +(define (drain-tty . maybe-tty) + (let ((tty (:optional maybe-tty (current-output-port)))) + (cond ((integer? tty) (%tcdrain tty)) ; File descriptor. + ((fdport? tty) ; Scheme port -- flush first. + (force-output tty) + (sleazy-call/fdes tty %tcdrain)) + ((string? tty) ; file name + (sleazy-call/file tty call-with-output-file %tcdrain)) + (else (error "Illegal argument to DRAIN-TTY" tty))))) (import-os-error-syscall %tcdrain (fdes) "sch_tcdrain") @@ -228,13 +237,21 @@ ;;; Note that the magic %flush-tty/foo constants must be defined before this ;;; file is loaded due to the flush-tty/foo definitions below. -(define (make-tty-flusher flag) - (lambda (fdport) - (sleazy-call/fdes fdport (lambda (fdes) (%tcflush fdes flag))))) +(define (make-input-tty-flusher flag) + (lambda maybe-tty + (sleazy-call/file (:optional maybe-tty (current-input-port)) + call-with-input-file + (lambda (fdes) (%tcflush fdes flag))))) -(define flush-tty/input (make-tty-flusher %flush-tty/input)) -(define flush-tty/output (make-tty-flusher %flush-tty/output)) -(define flush-tty/both (make-tty-flusher %flush-tty/both)) +(define (make-output-tty-flusher flag) + (lambda maybe-tty + (sleazy-call/file (:optional maybe-tty (current-output-port)) + call-with-output-file + (lambda (fdes) (%tcflush fdes flag))))) + +(define flush-tty/input (make-input-tty-flusher %flush-tty/input)) +(define flush-tty/output (make-output-tty-flusher %flush-tty/output)) +(define flush-tty/both (make-input-tty-flusher %flush-tty/both)) (import-os-error-syscall %tcflush (fdes flag) "sch_tcflush") @@ -243,14 +260,22 @@ ;;; Note that the magic %tcflow/foo constants must be defined before this ;;; file is loaded due to the definitions below. -(define (make-flow-controller action) - (lambda (fdport) - (sleazy-call/fdes fdport (lambda (fdes) (%tcflow fdes action))))) +(define (make-input-flow-controller action) + (lambda maybe-tty + (sleazy-call/file (:optional maybe-tty (current-input-port)) + call-with-input-file + (lambda (fdes) (%tcflow fdes action))))) -(define start-tty-output (make-flow-controller %tcflow/start-out)) -(define stop-tty-output (make-flow-controller %tcflow/stop-out)) -(define start-tty-input (make-flow-controller %tcflow/start-in)) -(define stop-tty-input (make-flow-controller %tcflow/stop-in)) +(define (make-output-flow-controller action) + (lambda maybe-tty + (sleazy-call/file (:optional maybe-tty (current-output-port)) + call-with-output-file + (lambda (fdes) (%tcflow fdes action))))) + +(define start-tty-output (make-output-flow-controller %tcflow/start-out)) +(define stop-tty-output (make-output-flow-controller %tcflow/stop-out)) +(define start-tty-input (make-input-flow-controller %tcflow/start-in)) +(define stop-tty-input (make-input-flow-controller %tcflow/stop-in)) (import-os-error-syscall %tcflow (fdes action) "sch_tcflow") @@ -275,8 +300,8 @@ ;;; Set/Get tty process group ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (set-tty-process-group port/fd proc-group) - (sleazy-call/fdes port/fd +(define (set-tty-process-group port/fd/fname proc-group) + (sleazy-call/file port/fd/fname call-with-input-file (lambda (fd) (%set-tty-process-group fd (if (integer? proc-group) proc-group @@ -284,8 +309,8 @@ (import-os-error-syscall %set-tty-process-group (fdes pid) "sch_tcsetpgrp") -(define (tty-process-group port/fd) - (sleazy-call/fdes port/fd %tty-process-group)) +(define (tty-process-group port/fd/fname) + (sleazy-call/file port/fd/fname call-with-input-file %tty-process-group)) (import-os-error-syscall %tty-process-group (fdes) "sch_tcgetpgrp")