Renamed tc* to tty*, and rehacked extensively.
This commit is contained in:
shivers
parent
0f0db549f5
commit
0ae16c8daa
60
scsh/tc.c
60
scsh/tc.c
|
|
@ -1,60 +0,0 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by cig.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h> /* For malloc. */
|
||||
#include "libcig.h"
|
||||
|
||||
#include <termios.h>
|
||||
|
||||
|
||||
extern int errno;
|
||||
|
||||
#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))
|
||||
#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)
|
||||
#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE)
|
||||
scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args)
|
||||
{
|
||||
extern int scheme_tcgetattr(int , const char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *);
|
||||
scheme_value ret1;
|
||||
int r1;
|
||||
int r2;
|
||||
int r3;
|
||||
int r4;
|
||||
int r5;
|
||||
int r6;
|
||||
int r7;
|
||||
int r8;
|
||||
int r9;
|
||||
int r10;
|
||||
int r11;
|
||||
|
||||
cig_check_nargs(3, nargs, "scheme_tcgetattr");
|
||||
r1 = scheme_tcgetattr(EXTRACT_FIXNUM(args[2]), cig_string_body(args[1]), &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11);
|
||||
ret1 = errno_or_false(r1);
|
||||
VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
|
||||
VECTOR_REF(*args,1) = ENTER_FIXNUM(r3);
|
||||
VECTOR_REF(*args,2) = ENTER_FIXNUM(r4);
|
||||
VECTOR_REF(*args,3) = ENTER_FIXNUM(r5);
|
||||
VECTOR_REF(*args,4) = ENTER_FIXNUM(r6);
|
||||
VECTOR_REF(*args,5) = ENTER_FIXNUM(r7);
|
||||
VECTOR_REF(*args,6) = ENTER_FIXNUM(r8);
|
||||
VECTOR_REF(*args,7) = ENTER_FIXNUM(r9);
|
||||
VECTOR_REF(*args,8) = ENTER_FIXNUM(r10);
|
||||
VECTOR_REF(*args,9) = ENTER_FIXNUM(r11);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
scheme_value df_scheme_tcsetattr(long nargs, scheme_value *args)
|
||||
{
|
||||
extern int scheme_tcsetattr(int , int , int , int , int , int , int , int , int , int , const char *, int , int );
|
||||
scheme_value ret1;
|
||||
int r1;
|
||||
|
||||
cig_check_nargs(13, nargs, "scheme_tcsetattr");
|
||||
r1 = scheme_tcsetattr(EXTRACT_FIXNUM(args[12]), EXTRACT_FIXNUM(args[11]), EXTRACT_FIXNUM(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), cig_string_body(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0]));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
274
scsh/tc.scm
274
scsh/tc.scm
|
|
@ -1,274 +0,0 @@
|
|||
;;; Terminal Control for the Scheme Shell
|
||||
;;; Copyright (c) 1995 by Brian D. Carlstrom.
|
||||
|
||||
;;; Scheme48 implementation.
|
||||
|
||||
(foreign-source
|
||||
"#include <termios.h>"
|
||||
""
|
||||
""
|
||||
"extern int errno;"
|
||||
""
|
||||
"#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))"
|
||||
"#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)"
|
||||
"#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE)"
|
||||
"" )
|
||||
|
||||
;;; terminal-info
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define-record terminal-info
|
||||
input-flags
|
||||
output-flags
|
||||
control-flags
|
||||
local-flags
|
||||
control-chars
|
||||
input-speed
|
||||
output-speed)
|
||||
|
||||
;;; tcgetattr
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (terminal-info fdport)
|
||||
(let ((control-chars (make-string cc/nccs)))
|
||||
(receive (iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed)
|
||||
(%tcgetattr (->fdes fdport) control-chars)
|
||||
(make-terminal-info (bitwise-ior
|
||||
(arithmetic-shift iflag-hi8 24) iflag-lo24)
|
||||
(bitwise-ior
|
||||
(arithmetic-shift oflag-hi8 24) oflag-lo24)
|
||||
(bitwise-ior
|
||||
(arithmetic-shift cflag-hi8 24) cflag-lo24)
|
||||
(bitwise-ior
|
||||
(arithmetic-shift lflag-hi8 24) lflag-lo24)
|
||||
control-chars
|
||||
ispeed ospeed))))
|
||||
|
||||
(define-errno-syscall (%tcgetattr fdes control-chars) %tcgetattr/errno
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed)
|
||||
|
||||
(define-foreign %tcgetattr/errno
|
||||
(scheme_tcgetattr (integer fdes)
|
||||
(string control-chars))
|
||||
(to-scheme integer errno_or_false)
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer)
|
||||
|
||||
;;; tcsetattr
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (set-terminal-info fdport option info)
|
||||
(let ((if (terminal-info:input-flags info))
|
||||
(of (terminal-info:output-flags info))
|
||||
(cf (terminal-info:control-flags info))
|
||||
(lf (terminal-info:local-flags info))
|
||||
(cc (terminal-info:control-chars info))
|
||||
(is (terminal-info:input-speed info))
|
||||
(os (terminal-info:output-speed info)))
|
||||
(let ((iflag-hi8 (arithmetic-shift if -24))
|
||||
(iflag-lo24 (bitwise-and if #xffffff))
|
||||
(oflag-hi8 (arithmetic-shift of -24))
|
||||
(oflag-lo24 (bitwise-and of #xffffff))
|
||||
(cflag-hi8 (arithmetic-shift cf -24))
|
||||
(cflag-lo24 (bitwise-and cf #xffffff))
|
||||
(lflag-hi8 (arithmetic-shift lf -24))
|
||||
(lflag-lo24 (bitwise-and lf #xffffff)))
|
||||
(%tcsetattr (->fdes fdport) option
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
cc
|
||||
is os))))
|
||||
|
||||
(define-simple-errno-syscall (%tcsetattr fdes option
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
control-chars
|
||||
ispeed ospeed)
|
||||
%tcsetattr/errno)
|
||||
|
||||
(define-foreign %tcsetattr/errno
|
||||
(scheme_tcsetattr (integer fdes)
|
||||
(integer option)
|
||||
(integer iflag-hi8)
|
||||
(integer iflag-lo24)
|
||||
(integer oflag-hi8)
|
||||
(integer oflag-lo24)
|
||||
(integer cflag-hi8)
|
||||
(integer cflag-lo24)
|
||||
(integer lflag-hi8)
|
||||
(integer lflag-lo24)
|
||||
(string control-chars)
|
||||
(integer ispeed)
|
||||
(integer ospeed))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
;;; ->fdes - Peeks at fdes of a port
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (->fdes fdport)
|
||||
(cond ((integer? fdport) fdport)
|
||||
((input-port? fdport)
|
||||
(fdport-data:fd (extensible-input-port-local-data fdport)))
|
||||
((output-port? fdport)
|
||||
(fdport-data:fd (extensible-output-port-local-data fdport)))))
|
||||
|
||||
;;; Magic Numbers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; <sys/termios.h>
|
||||
(define tc/set-attributes/now 0) ; make change immediate
|
||||
(define tc/set-attributes/drain 1) ; drain output, then change
|
||||
(define tc/set-attributes/flush 2) ; drain output, flush input
|
||||
|
||||
;;; Special Control Characters
|
||||
;; Index into c_cc[] character array.
|
||||
;; Name Subscript Enabled by
|
||||
|
||||
;; POSIX
|
||||
(define cc/veof 0) ; icanon
|
||||
(define cc/veol 1) ; icanon
|
||||
(define cc/verase 2) ; icanon
|
||||
(define cc/vkill 3) ; icanon
|
||||
(define cc/vintr 4) ; isig
|
||||
(define cc/vquit 5) ; isig
|
||||
(define cc/vsusp 6) ; isig
|
||||
(define cc/vstart 7) ; ixon, ixoff
|
||||
(define cc/vstop 8) ; ixon, ixoff
|
||||
(define cc/vmin 9) ; !icanon
|
||||
(define cc/vtime 10) ; !icanon
|
||||
;; NeXT
|
||||
(define cc/vwerase 11) ; icanon
|
||||
(define cc/vreprint 12) ; icanon
|
||||
(define cc/vlnext 13) ; iexten
|
||||
(define cc/vdiscard 14) ; iexten
|
||||
(define cc/vdsusp 15) ; isig
|
||||
(define cc/vquote 16) ; icanon
|
||||
;; Number of Control Characters - *Not Exported*
|
||||
(define cc/nccs 17)
|
||||
|
||||
;;; Input flags - software input processing
|
||||
;; POSIX
|
||||
(define iflag/ignbrk #x00000001) ; ignore break condition
|
||||
(define iflag/brkint #x00000002) ; map break to sigintr
|
||||
(define iflag/ignpar #x00000004) ; ignore (discard) parity errors
|
||||
(define iflag/parmrk #x00000008) ; mark parity and framing errors
|
||||
(define iflag/inpck #x00000010) ; enable checking of parity errors
|
||||
(define iflag/istrip #x00000020) ; strip 8th bit off chars
|
||||
(define iflag/inlcr #x00000040) ; map nl into cr
|
||||
(define iflag/igncr #x00000080) ; ignore cr
|
||||
(define iflag/icrnl #x00000100) ; map cr to nl (ala crmod)
|
||||
(define iflag/ixon #x00000200) ; enable output flow control
|
||||
(define iflag/ixoff #x00000400) ; enable input flow control
|
||||
;;NeXT
|
||||
(define iflag/ixany #x00000800) ; any char will restart after stop
|
||||
(define iflag/imaxbel #x00002000) ; ring bell on input queue full
|
||||
|
||||
|
||||
;;; Output flags - software output processing
|
||||
;; POSIX
|
||||
(define oflag/opost #x00000001) ; enable following output processing
|
||||
;; NeXT
|
||||
(define oflag/onlcr #x00000002) ; map nl to cr-nl (ala crmod)
|
||||
; use the same bits as old delay flags
|
||||
(define oflag/nldelay #x00000300) ; \n delay
|
||||
(define oflag/nl0 #x00000000)
|
||||
(define oflag/nl1 #x00000100) ; tty 37
|
||||
(define oflag/nl2 #x00000200) ; vt05
|
||||
(define oflag/nl3 #x00000300)
|
||||
(define oflag/tbdelay #x00000c00) ; horizontal tab delay
|
||||
(define oflag/tab0 #x00000000)
|
||||
(define oflag/tab1 #x00000400) ; tty 37
|
||||
(define oflag/tab2 #x00000800)
|
||||
(define oflag/xtabs #x00000c00) ; expand tabs on output
|
||||
(define oflag/crdelay #x00003000) ; \r delay
|
||||
(define oflag/cr0 #x00000000)
|
||||
(define oflag/cr1 #x00001000) ; tn 300
|
||||
(define oflag/cr2 #x00002000) ; tty 37
|
||||
(define oflag/cr3 #x00003000) ; concept 100
|
||||
(define oflag/vtdelay #x00004000) ; vertical tab delay
|
||||
(define oflag/ff0 #x00000000)
|
||||
(define oflag/ff1 #x00004000) ; tty 37
|
||||
(define oflag/bsdelay #x00008000) ; \b delay
|
||||
(define oflag/bs0 #x00000000)
|
||||
(define oflag/bs1 #x00008000)
|
||||
(define oflag/alldelay (bitwise-ior
|
||||
(bitwise-ior
|
||||
(bitwise-ior oflag/nldelay oflag/tbdelay)
|
||||
(bitwise-ior oflag/crdelay oflag/vtdelay))
|
||||
oflag/bsdelay))
|
||||
|
||||
;;; Control flags - hardware control of terminal
|
||||
;; NeXT
|
||||
(define cflag/cignore #x00000001) ; ignore control flags
|
||||
;; POSIX
|
||||
(define cflag/csize #x00000300) ; character size mask
|
||||
(define cflag/cs5 #x00000000) ; 5 bits (pseudo)
|
||||
(define cflag/cs6 #x00000100) ; 6 bits
|
||||
(define cflag/cs7 #x00000200) ; 7 bits
|
||||
(define cflag/cs8 #x00000300) ; 8 bits
|
||||
(define cflag/cstopb #x00000400) ; send 2 stop bits
|
||||
(define cflag/cread #x00000800) ; enable receiver
|
||||
(define cflag/parenb #x00001000) ; parity enable
|
||||
(define cflag/parodd #x00002000) ; odd parity, else even
|
||||
(define cflag/hupcl #x00004000) ; hang up on last close
|
||||
(define cflag/clocal #x00008000) ; ignore modem status lines
|
||||
;; NeXT
|
||||
(define cflag/cstopb110 #x00010000)
|
||||
(define cflag/par0 #x00020000) ; space parity
|
||||
(define cflag/par1 #x00040000) ; mark parity
|
||||
|
||||
;;; "Local" flags - dumping ground for other state
|
||||
;; Warning: some flags in this structure begin with
|
||||
;; the letter "I" and look like they belong in the
|
||||
;; input flag.
|
||||
;; NeXT
|
||||
(define lflag/echoke #x00000001) ; visual erase for line kill
|
||||
;; POSIX
|
||||
(define lflag/echoe #x00000002) ; visually erase chars
|
||||
(define lflag/echok #x00000004) ; echo nl after line kill
|
||||
(define lflag/echo #x00000008) ; enable echoing
|
||||
(define lflag/echonl #x00000010) ; echo nl even if echo is off
|
||||
(define lflag/icanon #x00000020) ; canonicalize input lines
|
||||
(define lflag/isig #x00000040) ; enable signals intr, quit, [d]susp
|
||||
(define lflag/iexten #x00000080) ; enable discard and lnext
|
||||
;; NeXT
|
||||
(define lflag/echocrt #x00000100) ; visual erase mode for crt
|
||||
(define lflag/echoprt #x00000200) ; visual erase mode for hardcopy
|
||||
(define lflag/echoctl #x00000400) ; echo control chars as ^(char)
|
||||
(define lflag/altwerase #x00000800) ; use alternate werase algorithm
|
||||
(define lflag/mdmbuf #x00100000) ; flow control output via carrier
|
||||
;; POSIX
|
||||
(define lflag/tostop #x00400000) ; stop background jobs from output
|
||||
;; NeXT
|
||||
(define lflag/xlcase #x04000000)
|
||||
(define lflag/xeucbksp #x08000000)
|
||||
;; POSIX
|
||||
(define lflag/noflsh #x80000000) ; don't flush after interrupt
|
||||
|
||||
;;; Baud Rates
|
||||
(define baud/0 0)
|
||||
(define baud/50 1)
|
||||
(define baud/75 2)
|
||||
(define baud/110 3)
|
||||
(define baud/134 4)
|
||||
(define baud/150 5)
|
||||
(define baud/200 6)
|
||||
(define baud/300 7)
|
||||
(define baud/600 8)
|
||||
(define baud/1200 9)
|
||||
(define baud/1800 10)
|
||||
(define baud/2400 11)
|
||||
(define baud/4800 12)
|
||||
(define baud/9600 13)
|
||||
(define baud/19200 14)
|
||||
(define baud/38400 15)
|
||||
File diff suppressed because one or more lines are too long
|
|
@ -0,0 +1,269 @@
|
|||
;;; To do:
|
||||
;;; Add new bindings to scsh-level-0 interface defn.
|
||||
;;; Magic constant defns.
|
||||
|
||||
;;; My comments:
|
||||
;;; - We have a lot of NeXT-specific stuff. More importantly, what is the
|
||||
;;; Linux, Solaris, and HP-UX specific stuff?
|
||||
;;;
|
||||
;;; - I would suggest totally flushing the ttychars vector from the interface
|
||||
;;; in favor of individual slots in the TTY-INFO record. Keep the vec
|
||||
;;; in the implementation, and define the TTY-INFO:EOL, etc. procs by
|
||||
;;; hand as being indices into the vector. We could *also* expose the
|
||||
;;; vector if we liked.
|
||||
;;; -Olin
|
||||
|
||||
;;; Terminal Control for the Scheme Shell
|
||||
;;; Copyright (c) 1995 by Brian D. Carlstrom.
|
||||
;;; Rehacked by Olin 8/95.
|
||||
|
||||
(foreign-source
|
||||
"#include <termios.h>"
|
||||
""
|
||||
"extern int errno;"
|
||||
""
|
||||
"#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)"
|
||||
"" )
|
||||
|
||||
|
||||
;;; tty-info records
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; I have to fake out my record package so I can define my very own
|
||||
;;; MAKE-TTY-INFO procedure. Ech. I oughta have a lower-level record macro
|
||||
;;; for this kind of thing.
|
||||
|
||||
(define-record %tty-info
|
||||
control-chars
|
||||
input-flags
|
||||
output-flags
|
||||
control-flags
|
||||
local-flags
|
||||
input-speed
|
||||
output-speed
|
||||
min
|
||||
time
|
||||
((disclose info) '(tty-info)))
|
||||
|
||||
(define tty-info? %tty-info?)
|
||||
(define type/tty-info %type/tty-info)
|
||||
|
||||
(define tty-info:control-chars %tty-info:control-chars)
|
||||
(define tty-info:input-flags %tty-info:input-flags)
|
||||
(define tty-info:output-flags %tty-info:output-flags)
|
||||
(define tty-info:control-flags %tty-info:control-flags)
|
||||
(define tty-info:local-flags %tty-info:local-flags)
|
||||
(define tty-info:input-speed %tty-info:input-speed)
|
||||
(define tty-info:output-speed %tty-info:output-speed)
|
||||
(define tty-info:min %tty-info:min)
|
||||
|
||||
(define set-tty-info:control-chars set-%tty-info:control-chars)
|
||||
(define set-tty-info:input-flags set-%tty-info:input-flags)
|
||||
(define set-tty-info:output-flags set-%tty-info:output-flags)
|
||||
(define set-tty-info:control-flags set-%tty-info:control-flags)
|
||||
(define set-tty-info:local-flags set-%tty-info:local-flags)
|
||||
(define set-tty-info:input-speed set-%tty-info:input-speed)
|
||||
(define set-tty-info:output-speed set-%tty-info:output-speed)
|
||||
(define set-tty-info:min set-%tty-info:min)
|
||||
|
||||
(define (make-tty-info iflags oflags cflags lflags ispeed ospeed min time)
|
||||
(make-%tty-info (make-string num-ttychars (ascii->char 0))
|
||||
iflags oflags cflags lflags ispeed ospeed min time))
|
||||
|
||||
(define (copy-tty-info info)
|
||||
(make-%tty-info (string-copy (tty-info:control-chars info))
|
||||
(tty-info:input-flags info)
|
||||
(tty-info:output-flags info)
|
||||
(tty-info:control-flags info)
|
||||
(tty-info:local-flags info)
|
||||
(tty-info:input-speed info)
|
||||
(tty-info:output-speed info)
|
||||
(tty-info:min info)
|
||||
(tty-info:time info)))
|
||||
|
||||
|
||||
;;; (tty-info fd/port)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Retrieve tty-info bits from a tty.
|
||||
|
||||
(define (tty-info fdport)
|
||||
(let ((control-chars (make-string num-ttychars)))
|
||||
(receive (iflag-hi8 iflag-lo24 oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24 lflag-hi8 lflag-lo24
|
||||
ispeed ospeed)
|
||||
(call/fdes fdport (lambda (fd) (%tty-info fd control-chars)))
|
||||
(make-%tty-info control-chars
|
||||
(bitwise-ior (arithmetic-shift iflag-hi8 24) iflag-lo24)
|
||||
(bitwise-ior (arithmetic-shift oflag-hi8 24) oflag-lo24)
|
||||
(bitwise-ior (arithmetic-shift cflag-hi8 24) cflag-lo24)
|
||||
(bitwise-ior (arithmetic-shift lflag-hi8 24) lflag-lo24)
|
||||
ispeed ospeed
|
||||
(char->ascii (string-ref control-chars ttychar/min))
|
||||
(char->ascii (string-ref control-chars ttychar/time))))))
|
||||
|
||||
(define-errno-syscall (%tty-info fdes control-chars) %tty-info/errno
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed)
|
||||
|
||||
(define-foreign %tty-info/errno
|
||||
(scheme_tty_info (integer fdes)
|
||||
(string control-chars))
|
||||
(to-scheme integer errno_or_false)
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer
|
||||
integer integer)
|
||||
|
||||
|
||||
;;; (set-tty-info fdport option info) [Not exported]
|
||||
;;; (set-tty-info/now fdport option info)
|
||||
;;; (set-tty-info/drain fdport option info)
|
||||
;;; (set-tty-info/flush fdport option info)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Assign tty-info bits to a tty.
|
||||
|
||||
(define (set-tty-info fdport option info)
|
||||
(let ((if (tty-info:input-flags info))
|
||||
(of (tty-info:output-flags info))
|
||||
(cf (tty-info:control-flags info))
|
||||
(lf (tty-info:local-flags info))
|
||||
(cc (tty-info:control-chars info))
|
||||
(is (tty-info:input-speed info))
|
||||
(os (tty-info:output-speed info)))
|
||||
(let ((iflag-hi8 (arithmetic-shift if -24))
|
||||
(iflag-lo24 (bitwise-and if #xffffff))
|
||||
(oflag-hi8 (arithmetic-shift of -24))
|
||||
(oflag-lo24 (bitwise-and of #xffffff))
|
||||
(cflag-hi8 (arithmetic-shift cf -24))
|
||||
(cflag-lo24 (bitwise-and cf #xffffff))
|
||||
(lflag-hi8 (arithmetic-shift lf -24))
|
||||
(lflag-lo24 (bitwise-and lf #xffffff)))
|
||||
(call/fdes fdport
|
||||
(lambda (fd)
|
||||
(%set-tty-info fd option
|
||||
cc
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
is os
|
||||
(tty-info:min info)
|
||||
(tty-info:time info)))))))
|
||||
|
||||
(define-simple-errno-syscall (%set-tty-info fdes option
|
||||
control-chars
|
||||
iflag-hi8 iflag-lo24
|
||||
oflag-hi8 oflag-lo24
|
||||
cflag-hi8 cflag-lo24
|
||||
lflag-hi8 lflag-lo24
|
||||
ispeed ospeed
|
||||
min time)
|
||||
%set-tty-info/errno)
|
||||
|
||||
(define-foreign %set-tty-info/errno
|
||||
(scheme_set_tty_info (integer fdes)
|
||||
(integer option)
|
||||
(string control-chars)
|
||||
(integer iflag-hi8)
|
||||
(integer iflag-lo24)
|
||||
(integer oflag-hi8)
|
||||
(integer oflag-lo24)
|
||||
(integer cflag-hi8)
|
||||
(integer cflag-lo24)
|
||||
(integer lflag-hi8)
|
||||
(integer lflag-lo24)
|
||||
(integer ispeed)
|
||||
(integer ospeed)
|
||||
(integer min)
|
||||
(integer time))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
|
||||
;;; Magic Numbers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; <termios.h>
|
||||
(define %set-tty-info/now 0) ; Make change immediately.
|
||||
(define %set-tty-info/drain 1) ; Drain output, then change.
|
||||
(define %set-tty-info/flush 2) ; Drain output, flush input.
|
||||
|
||||
;;; Exported procs
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (set-tty-info/now fd/port info)
|
||||
(set-tty-info fd/port %set-tty-info/now info))
|
||||
|
||||
(define (set-tty-info/drain fd/port info)
|
||||
(set-tty-info fd/port %set-tty-info/drain info))
|
||||
|
||||
(define (set-tty-info/flush fd/port info)
|
||||
(set-tty-info fd/port %set-tty-info/flush info))
|
||||
|
||||
|
||||
;;; Send a break on the serial line.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (send-tty-break fdport . maybe-duration)
|
||||
(call/fdes fdport
|
||||
(lambda (fdes)
|
||||
(%send-tty-break-fdes fdes (optional-arg maybe-duration 0)))))
|
||||
|
||||
(define-errno-syscall (%send-tty-break-fdes fdes duration)
|
||||
%send-tty-break-fdes/errno)
|
||||
|
||||
(define-foreign %send-tty-break-fdes/errno
|
||||
(tcsendbreak (integer fdes) (integer duration))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
|
||||
;;; Drain the main vein.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (drain-tty fdport)
|
||||
(cond ((integer? fdport) (%tcdrain fdport)) ; File descriptor.
|
||||
((fdport? fdport) ; Scheme port -- flush first.
|
||||
(force-output fdport)
|
||||
(call/fdes fdport %tcdrain))
|
||||
(else (error "Illegal argument to DRAIN-TTY" fdport))))
|
||||
|
||||
(define-errno-syscall (%tcdrain fdes) %tcdrain/errno)
|
||||
(define-foreign %tcdrain/errno (tcdrain (integer fdes))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
|
||||
;;; Flushing the device queues. (tcflush)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (make-tty-flusher flag)
|
||||
(lambda (fdport)
|
||||
(call/fdes fdport (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-errno-syscall (%tcflush fdes flag) %tcflush/errno)
|
||||
(define-foreign %tcflush/errno (tcflush (integer fdes) (integer flag))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
||||
|
||||
;;; Stopping and starting I/O (tcflow)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (make-flow-controller action)
|
||||
(lambda (fdport)
|
||||
(call/fdes fdport (lambda (fdes) (%tcflow fdes action)))))
|
||||
|
||||
(define start-tty-output (make-tty-flow-controller %tcflow/start-out))
|
||||
(define stop-tty-output (make-tty-flow-controller %tcflow/stop-out))))
|
||||
(define start-tty-input (make-tty-flow-controller %tcflow/start-in))
|
||||
(define stop-tty-input (make-tty-flow-controller %tcflow/stop-in))
|
||||
|
||||
(define-errno-syscall (%tcflow fdes action) %tcflow/errno)
|
||||
|
||||
(define-foreign %tcflow/errno
|
||||
(tcflow (integer fdes) (integer action))
|
||||
(to-scheme integer errno_or_false))
|
||||
|
|
@ -1,15 +1,17 @@
|
|||
/* To do:
|
||||
* - Replace explicit 8/24 splits with macros.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Scheme48/scsh terminal control interface.
|
||||
* Routines that require custom C support.
|
||||
* Copyright (c) 1995 by Brian D. Carlstrom
|
||||
*/
|
||||
|
||||
#include "cstuff.h"
|
||||
#include <termios.h>
|
||||
#include <memory.h>
|
||||
#include <string.h>
|
||||
|
||||
int scheme_tcgetattr(int fd,
|
||||
char control_chars[NCCS],
|
||||
int scheme_tcgetattr(int fd, char control_chars[NCCS],
|
||||
int *iflag_hi8, int *iflag_lo24,
|
||||
int *oflag_hi8, int *oflag_lo24,
|
||||
int *cflag_hi8, int *cflag_lo24,
|
||||
|
|
@ -17,33 +19,36 @@ int scheme_tcgetattr(int fd,
|
|||
int *ispeed, int *ospeed)
|
||||
{
|
||||
struct termios t;
|
||||
int result=tcgetattr(fd,&t);
|
||||
int result = tcgetattr(fd, &t);
|
||||
|
||||
if (result == -1)
|
||||
return result;
|
||||
|
||||
memcpy(control_chars,t.c_cc,NCCS);
|
||||
*iflag_hi8 =t.c_iflag >> 24; *iflag_lo24=t.c_iflag & 0xffffff;
|
||||
*oflag_hi8 =t.c_oflag >> 24; *oflag_lo24=t.c_oflag & 0xffffff;
|
||||
*cflag_hi8 =t.c_cflag >> 24; *cflag_lo24=t.c_cflag & 0xffffff;
|
||||
*lflag_hi8 =t.c_lflag >> 24; *lflag_lo24=t.c_lflag & 0xffffff;
|
||||
*ispeed=cfgetispeed(&t);
|
||||
*ospeed=cfgetospeed(&t);
|
||||
return result;
|
||||
}
|
||||
if (result != -1) {
|
||||
memcpy(control_chars, t.c_cc, NCCS);
|
||||
*iflag_hi8 =t.c_iflag >> 24; *iflag_lo24=t.c_iflag & 0xffffff;
|
||||
*oflag_hi8 =t.c_oflag >> 24; *oflag_lo24=t.c_oflag & 0xffffff;
|
||||
*cflag_hi8 =t.c_cflag >> 24; *cflag_lo24=t.c_cflag & 0xffffff;
|
||||
*lflag_hi8 =t.c_lflag >> 24; *lflag_lo24=t.c_lflag & 0xffffff;
|
||||
*ispeed=cfgetispeed(&t);
|
||||
*ospeed=cfgetospeed(&t);
|
||||
}
|
||||
|
||||
int scheme_tcsetattr(int fd,
|
||||
int option,
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
int scheme_tcsetattr(int fd, int option,
|
||||
char *control_chars,
|
||||
int iflag_hi8, int iflag_lo24,
|
||||
int oflag_hi8, int oflag_lo24,
|
||||
int cflag_hi8, int cflag_lo24,
|
||||
int lflag_hi8, int lflag_lo24,
|
||||
char *control_chars,
|
||||
int ispeed, int ospeed)
|
||||
int ispeed, int ospeed,
|
||||
int min, int time)
|
||||
{
|
||||
struct termios t;
|
||||
|
||||
memcpy(t.c_cc,control_chars,NCCS);
|
||||
memcpy(t.c_cc, control_chars, NCCS);
|
||||
t.c_cc[VMIN] = min;
|
||||
t.c_cc[VTIME] = time;
|
||||
t.c_iflag = (iflag_hi8 << 24) | iflag_lo24;
|
||||
t.c_oflag = (oflag_hi8 << 24) | oflag_lo24;
|
||||
t.c_cflag = (cflag_hi8 << 24) | cflag_lo24;
|
||||
|
|
@ -51,5 +56,5 @@ int scheme_tcsetattr(int fd,
|
|||
cfsetispeed(&t, ispeed);
|
||||
cfsetospeed(&t, ospeed);
|
||||
|
||||
return(tcsetattr(fd,option,&t));
|
||||
return tcsetattr(fd, option, &t);
|
||||
}
|
||||
Loading…
Reference in New Issue