Most of the tty procedures now again take file name arguments.
Made some arguments optional again.
This commit is contained in:
parent
cc3f5b07bc
commit
df9c8bee6c
85
scsh/tty.scm
85
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")
|
||||
|
||||
|
|
Loading…
Reference in New Issue