updating stty with get-terminal-width

(debated creating a full ioctl module, but all you really want
from ioctl is the TIOCGWINSZ command)
This commit is contained in:
Alex Shinn 2010-05-15 15:25:43 +09:00
parent 87d13c3a46
commit 3002d71a65
3 changed files with 30 additions and 8 deletions

View file

@ -1,10 +1,11 @@
(define-module (chibi stty) (define-module (chibi stty)
(export stty with-stty TCSANOW TCSADRAIN TCSAFLUSH) (export stty with-stty with-raw-io
get-terminal-width get-terminal-dimensions
TCSANOW TCSADRAIN TCSAFLUSH)
(import-immutable (scheme) (import-immutable (scheme)
(srfi 33) (srfi 33)
(srfi 69)) (srfi 69))
(include-shared "stty") (include-shared "stty")
(include "stty.scm") (include "stty.scm"))
)

View file

@ -205,7 +205,7 @@
((char) ((char)
;;(term-attrs-cc-set! attr (cadr x) (or (cadr lst) 0)) ;;(term-attrs-cc-set! attr (cadr x) (or (cadr lst) 0))
(lp (cddr lst) iflag oflag cflag lflag invert? return)) (lp (cddr lst) iflag oflag cflag lflag invert? return))
((combine) ;; recurse on def of this command ((combine)
(lp (cadr x) iflag oflag cflag lflag invert? (lp (cadr x) iflag oflag cflag lflag invert?
(lambda (i o c l) (lp (cdr lst) i o c l invert? return)))) (lambda (i o c l) (lp (cdr lst) i o c l invert? return))))
((special) ((special)
@ -222,3 +222,14 @@
(lambda () (stty setting)) (lambda () (stty setting))
thunk thunk
(lambda () (set-terminal-attributes! port TCSANOW orig-attrs))))) (lambda () (set-terminal-attributes! port TCSANOW orig-attrs)))))
(define (with-raw-io port thunk)
(with-stty '(not icanon echo) thunk port))
(define (get-terminal-width x)
(let ((ws (ioctl x TIOCGWINSZ)))
(and ws (winsize-col ws))))
(define (get-terminal-dimensions x)
(let ((ws (ioctl x TIOCGWINSZ)))
(and ws (list (winsize-col ws) (winsize-row ws)))))

View file

@ -1,10 +1,10 @@
(c-system-include "termios.h") (c-system-include "termios.h")
(c-system-include "sys/ioctl.h")
(define-c-struct termios (define-c-struct termios
predicate: term-attrs? predicate: term-attrs?
constructor: (make-term-attrs) constructor: (make-term-attrs)
;;destructor: free-term-attrs
(unsigned-long c_iflag term-attrs-iflag term-attrs-iflag-set!) (unsigned-long c_iflag term-attrs-iflag term-attrs-iflag-set!)
(unsigned-long c_oflag term-attrs-oflag term-attrs-oflag-set!) (unsigned-long c_oflag term-attrs-oflag term-attrs-oflag-set!)
(unsigned-long c_cflag term-attrs-cflag term-attrs-cflag-set!) (unsigned-long c_cflag term-attrs-cflag term-attrs-cflag-set!)
@ -13,10 +13,18 @@
(unsigned-long c_ispeed term-attrs-ispeed term-attrs-ispeed-set!) (unsigned-long c_ispeed term-attrs-ispeed term-attrs-ispeed-set!)
(unsigned-long c_ospeed term-attrs-ospeed term-attrs-ospeed-set!)) (unsigned-long c_ospeed term-attrs-ospeed term-attrs-ospeed-set!))
(define-c-struct winsize
predicate: winsize?
(unsigned-short ws_row winsize-row)
(unsigned-short ws_col winsize-col))
(define-c errno ioctl (port-or-fd unsigned-long (result winsize)))
(define-c-const int TIOCGWINSZ)
(define-c-const int TCSANOW) (define-c-const int TCSANOW)
(define-c-const int TCSADRAIN) (define-c-const int TCSADRAIN)
(define-c-const int TCSAFLUSH) (define-c-const int TCSAFLUSH)
;; (define-c-const int TCSASOFT)
(define-c-const unsigned-long IGNBRK) (define-c-const unsigned-long IGNBRK)
(define-c-const unsigned-long BRKINT) (define-c-const unsigned-long BRKINT)
@ -92,5 +100,7 @@
(define-c-const unsigned-long VREPRINT) (define-c-const unsigned-long VREPRINT)
;; (define-c-const unsigned-long VSTATUS) ;; (define-c-const unsigned-long VSTATUS)
(define-c errno (get-terminal-attributes "tcgetattr") (port-or-fd (result termios))) (define-c errno (get-terminal-attributes "tcgetattr")
(define-c errno (set-terminal-attributes! "tcsetattr") (port-or-fd int termios)) (port-or-fd (result termios)))
(define-c errno (set-terminal-attributes! "tcsetattr")
(port-or-fd int termios))