mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 12:10:26 +02:00
Code Activity

close-port implementation in sports

Browse source 
* module/ice-9/sports.scm (close-port): New function.
  (port-bindings): Add close-port.
This commit is contained in:
Andy Wingo 2016-05-24 07:14:26 +02:00
parent 690b856d59
commit 25381bdbc0
1 changed files with 12 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/ice-9/sports.scm
View file

@ -54,7 +54,8 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:replace (peek-char #:replace (peek-char
read-char read-char
force-output) force-output
close-port)
#:export (lookahead-u8 #:export (lookahead-u8
get-u8 get-u8
get-bytevector-n get-bytevector-n
@ -92,6 +93,15 @@
(error "not an open output port" port)) (error "not an open output port" port))
(flush-output port)) (flush-output port))
(define close-port
(let ((%close-port (@ (guile) close-port)))
(lambda (port)
(cond
((port-closed? port) #f)
(else
(when (output-port? port) (flush-output port))
(%close-port port))))))
(define (default-read-waiter port) (port-poll port "r")) (define (default-read-waiter port) (port-poll port "r"))
(define (default-write-waiter port) (port-poll port "w")) (define (default-write-waiter port) (port-poll port "w"))
@ -579,7 +589,7 @@
(define saved-port-bindings #f) (define saved-port-bindings #f)
(define port-bindings (define port-bindings
'(((guile) read-char peek-char force-output) '(((guile) read-char peek-char force-output close-port)
((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n) ((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n)
((ice-9 rdelim) %read-line read-line read-delimited))) ((ice-9 rdelim) %read-line read-line read-delimited)))
(define (install-sports!) (define (install-sports!)