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)
(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")