Hi all, Attached is a relatively straightforward patch to move the "terminal port" procedures to port.scm. This requires a few small tweaks to make it work cross-platform (because in posixwin.scm we had a define-unimplemented for terminal-name).
Cheers, Peter
From e2a2c96ca1ab2e82ffd60ff5bdc180b89383dba2 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 11 Feb 2018 14:34:05 +0100
Subject: [PATCH] Move terminal port procedures from posix to chicken.port
---
port.scm | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++
posix.scm | 1 -
posixunix.scm | 56 ----------------------------------
posixwin.scm | 14 ---------
tests/port-tests.scm | 3 +-
types.db | 8 +++--
6 files changed, 91 insertions(+), 76 deletions(-)
diff --git a/port.scm b/port.scm
index 2915a596..925a3dbb 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,43 @@
(include "common-declarations.scm")
+#>
+
+#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;
+ 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 +402,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
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
