Most of the tty procedures now again take file name arguments.

Made some arguments optional again.
This commit is contained in:
mainzelm 2003-03-03 10:46:09 +00:00
parent cc3f5b07bc
commit df9c8bee6c
1 changed files with 55 additions and 30 deletions

View File

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