From 789bf282bc576e24b06683d0dec530c9369b9e04 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 11 Feb 2018 14:34:05 +0100 Subject: [PATCH] Move terminal port procedures from posix to chicken.port --- port.scm | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++++ posix.scm | 1 - posixunix.scm | 56 -------------------------------- posixwin.scm | 14 -------- tests/port-tests.scm | 3 +- types.db | 8 +++-- 6 files changed, 97 insertions(+), 76 deletions(-) diff --git a/port.scm b/port.scm index 2915a596..a8d3e4d4 100644 --- a/port.scm +++ b/port.scm @@ -52,6 +52,9 @@ make-concatenated-port set-buffering-mode! set-port-name! + terminal-name + terminal-port? + terminal-size with-error-output-to-port with-input-from-port with-input-from-string @@ -68,6 +71,49 @@ (include "common-declarations.scm") +#> + +#if !defined(_WIN32) +# include +# include +#endif + +#define C_C_fileno(p) C_fix(fileno(C_port_file(p))) + +#if !defined(__ANDROID__) && defined(TIOCGWINSZ) +static int get_tty_size(int p, int *rows, int *cols) +{ + struct winsize tty_size; + int r; + + memset(&tty_size, 0, sizeof tty_size); + + r = ioctl(p, TIOCGWINSZ, &tty_size); + if (r == 0) { + *rows = tty_size.ws_row; + *cols = tty_size.ws_col; + } + return r; +} +#else +static int get_tty_size(int p, int *rows, int *cols) +{ + *rows = *cols = 0; + errno = ENOSYS; + return -1; +} +#endif + +#if defined(_WIN32) && !defined(__CYGWIN__) +char *ttyname(int fd) { + errno = ENOSYS; + return NULL; +} +#endif + +<# + + (define-foreign-variable _iofbf int "_IOFBF") (define-foreign-variable _iolbf int "_IOLBF") (define-foreign-variable _ionbf int "_IONBF") @@ -362,4 +408,49 @@ (##sys#set-port-data! port (vector #f)) port)) +;; Duplication from posix-common.scm +(define posix-error + (let ((strerror (foreign-lambda c-string "strerror" int)) + (string-append string-append) ) + (lambda (type loc msg . args) + (let ((rn (##sys#update-errno))) + (apply ##sys#signal-hook type loc (string-append msg " - " (strerror rn)) args) ) ) ) ) + + +;; Terminal ports +(define (terminal-port? port) + (##sys#check-open-port port 'terminal-port?) + (let ((fp (##sys#peek-unsigned-integer port 0))) + (and (not (eq? 0 fp)) (##core#inline "C_tty_portp" port) ) ) ) + +(define (check-terminal! caller port) + (##sys#check-open-port port caller) + (unless (and (eq? 'stream (##sys#slot port 7)) + (##core#inline "C_tty_portp" port)) + (##sys#error caller "port is not connected to a terminal" port))) + +(define terminal-name + (let ((ttyname (foreign-lambda c-string "ttyname" int)) ) + (lambda (port) + (check-terminal! 'terminal-name port) + (or (ttyname (##core#inline "C_C_fileno" port) ) + (posix-error #:error 'terminal-name + "Could not determine terminal name" port)) ) ) ) + +(define terminal-size + (let ((ttysize (foreign-lambda int "get_tty_size" int + (nonnull-c-pointer int) + (nonnull-c-pointer int)))) + (lambda (port) + (check-terminal! 'terminal-size port) + (let-location ((columns int) + (rows int)) + (if (fx= 0 + (ttysize (##core#inline "C_C_fileno" port) + (location columns) + (location rows))) + (values columns rows) + (posix-error #:error 'terminal-size + "Unable to get size of terminal" port)))))) + ) diff --git a/posix.scm b/posix.scm index ad277bbb..d29a51f0 100644 --- a/posix.scm +++ b/posix.scm @@ -80,7 +80,6 @@ signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu signal/xfsz signals-list socket? spawn/detach spawn/nowait spawn/nowaito spawn/overlay spawn/wait string->time symbolic-link? - terminal-name terminal-port? terminal-size time->string user-information utc-time->seconds with-input-from-pipe with-output-to-pipe) diff --git a/posixunix.scm b/posixunix.scm index d757c291..124c6b6e 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -260,29 +260,6 @@ C_tm_get( C_word v, void *tm ) #define C_strptime(s, f, v, stm) \ (strptime(C_c_string(s), C_c_string(f), ((struct tm *)(stm))) ? C_tm_get((v), (stm)) : C_SCHEME_FALSE) -#if !defined(__ANDROID__) && defined(TIOCGWINSZ) -static int get_tty_size(int p, int *rows, int *cols) -{ - struct winsize tty_size; - int r; - - memset(&tty_size, 0, sizeof tty_size); - - r = ioctl(p, TIOCGWINSZ, &tty_size); - if (r == 0) { - *rows = tty_size.ws_row; - *cols = tty_size.ws_col; - } - return r; -} -#else -static int get_tty_size(int p, int *rows, int *cols) -{ - *rows = *cols = 0; - return -1; -} -#endif - static int set_file_mtime(char *filename, C_word atime, C_word mtime) { struct stat sb; @@ -1234,39 +1211,6 @@ static C_word C_i_fifo_p(C_word name) (define set-alarm! (foreign-lambda int "C_alarm" int)) -(define (terminal-port? port) - (##sys#check-open-port port 'terminal-port?) - (let ([fp (##sys#peek-unsigned-integer port 0)]) - (and (not (eq? 0 fp)) (##core#inline "C_tty_portp" port) ) ) ) - -(define (##sys#terminal-check caller port) - (##sys#check-open-port port caller) - (unless (and (eq? 'stream (##sys#slot port 7)) - (##core#inline "C_tty_portp" port)) - (##sys#error caller "port is not connected to a terminal" port))) - -(define terminal-name - (let ([ttyname (foreign-lambda nonnull-c-string "ttyname" int)] ) - (lambda (port) - (##sys#terminal-check 'terminal-name port) - (ttyname (##core#inline "C_C_fileno" port) ) ) ) ) - -(define terminal-size - (let ((ttysize (foreign-lambda int "get_tty_size" int - (nonnull-c-pointer int) - (nonnull-c-pointer int)))) - (lambda (port) - (##sys#terminal-check 'terminal-size port) - (let-location ((columns int) - (rows int)) - (if (fx= 0 - (ttysize (##core#inline "C_C_fileno" port) - (location columns) - (location rows))) - (values columns rows) - (posix-error #:error 'terminal-size - "Unable to get size of terminal" port)))))) - ;;; Process handling: diff --git a/posixwin.scm b/posixwin.scm index bc677051..7d97c426 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -46,7 +46,6 @@ ; prot/... ; map/... ; set-alarm! -; terminal-name ; process-fork process-wait ; parent-process-id ; process-signal @@ -951,18 +950,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) "C_return(z);") ) -;;; Other things: - -(define (terminal-port? port) - (##sys#check-open-port port 'terminal-port?) - (let ([fp (##sys#peek-unsigned-integer port 0)]) - (and (not (eq? 0 fp)) (##core#inline "C_tty_portp" port) ) ) ) - -(define (terminal-size port) - (if (terminal-port? port) - (values 0 0) - (##sys#error 'terminal-size "port is not connected to a terminal" port))) - ;;; Process handling: (define-foreign-variable _p_overlay int "P_OVERLAY") @@ -1171,7 +1158,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (define-unimplemented signal-mask!) (define-unimplemented signal-masked?) (define-unimplemented signal-unmask!) -(define-unimplemented terminal-name) (define-unimplemented user-information) (define-unimplemented utc-time->seconds) (define-unimplemented string->time) diff --git a/tests/port-tests.scm b/tests/port-tests.scm index b4774972..4e688b54 100644 --- a/tests/port-tests.scm +++ b/tests/port-tests.scm @@ -1,7 +1,6 @@ (import chicken.condition chicken.file chicken.file.posix chicken.flonum chicken.format chicken.io chicken.port - chicken.process chicken.process.signal chicken.tcp srfi-4 - chicken.posix) ; FIXME drop once terminal-port? is rehomed + chicken.process chicken.process.signal chicken.tcp srfi-4) (include "test.scm") (test-begin "ports") diff --git a/types.db b/types.db index c4fb1d4d..dc573f88 100644 --- a/types.db +++ b/types.db @@ -1861,6 +1861,11 @@ (#(procedure #:clean #:enforce) chicken.port#set-port-name! (port string) undefined) ((port string) (##sys#setslot #(1) '3 #(2)))) +(chicken.port#terminal-name (#(procedure #:clean #:enforce) chicken.port#terminal-name (port) string)) +(chicken.port#terminal-port? (#(procedure #:clean #:enforce) chicken.port#terminal-port? (port) boolean)) +(chicken.port#terminal-size (#(procedure #:clean #:enforce) chicken.port#terminal-size (port) fixnum fixnum)) + + ;; errno (chicken.errno#errno/2big fixnum) @@ -2089,9 +2094,6 @@ (chicken.posix#socket? (#(procedure #:clean #:enforce) chicken.posix#socket? ((or string fixnum)) boolean)) (chicken.posix#string->time (#(procedure #:clean #:enforce) chicken.posix#string->time (string #!optional string) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum))) (chicken.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.posix#symbolic-link? ((or string fixnum)) boolean)) -(chicken.posix#terminal-name (#(procedure #:clean #:enforce) chicken.posix#terminal-name (port) string)) -(chicken.posix#terminal-port? (#(procedure #:clean #:enforce) chicken.posix#terminal-port? (port) boolean)) -(chicken.posix#terminal-size (#(procedure #:clean #:enforce) chicken.posix#terminal-size (port) fixnum fixnum)) (chicken.posix#time->string (#(procedure #:clean #:enforce) chicken.posix#time->string ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum) #!optional string) string)) (chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *)) (chicken.posix#utc-time->seconds (#(procedure #:clean #:enforce) chicken.posix#utc-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) integer)) -- 2.11.0