mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-18 02:00:20 +02:00
73b03e98a7
* module/rnrs/io/ports.scm (open-string-input-port): (open-string-output-port): Ensure that the ports are unicode-capable by binding %default-port-encoding to "UTF-8".
124 lines
4.1 KiB
Scheme
124 lines
4.1 KiB
Scheme
;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*-
|
||
|
||
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
|
||
;;;;
|
||
;;;; This library is free software; you can redistribute it and/or
|
||
;;;; modify it under the terms of the GNU Lesser General Public
|
||
;;;; License as published by the Free Software Foundation; either
|
||
;;;; version 3 of the License, or (at your option) any later version.
|
||
;;;;
|
||
;;;; This library is distributed in the hope that it will be useful,
|
||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
;;;; Lesser General Public License for more details.
|
||
;;;;
|
||
;;;; You should have received a copy of the GNU Lesser General Public
|
||
;;;; License along with this library; if not, write to the Free Software
|
||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
|
||
;;; Author: Ludovic Courtès <ludo@gnu.org>
|
||
|
||
;;; Commentary:
|
||
;;;
|
||
;;; The I/O port API of the R6RS is provided by this module. In many areas
|
||
;;; it complements or refines Guile's own historical port API. For instance,
|
||
;;; it allows for binary I/O with bytevectors.
|
||
;;;
|
||
;;; Code:
|
||
|
||
(define-module (rnrs io ports)
|
||
#:version (6)
|
||
#:re-export (eof-object? port? input-port? output-port?)
|
||
#:export (eof-object
|
||
|
||
;; input & output ports
|
||
port-transcoder binary-port? transcoded-port
|
||
port-position set-port-position!
|
||
port-has-port-position? port-has-set-port-position!?
|
||
call-with-port
|
||
|
||
;; input ports
|
||
open-bytevector-input-port
|
||
open-string-input-port
|
||
make-custom-binary-input-port
|
||
|
||
;; binary input
|
||
get-u8 lookahead-u8
|
||
get-bytevector-n get-bytevector-n!
|
||
get-bytevector-some get-bytevector-all
|
||
|
||
;; output ports
|
||
open-bytevector-output-port
|
||
open-string-output-port
|
||
make-custom-binary-output-port
|
||
|
||
;; binary output
|
||
put-u8 put-bytevector))
|
||
|
||
(load-extension (string-append "libguile-" (effective-version))
|
||
"scm_init_r6rs_ports")
|
||
|
||
|
||
|
||
;;;
|
||
;;; Input and output ports.
|
||
;;;
|
||
|
||
(define (port-transcoder port)
|
||
(error "port transcoders are not supported" port))
|
||
|
||
(define (binary-port? port)
|
||
;; So far, we don't support transcoders other than the binary transcoder.
|
||
#t)
|
||
|
||
(define (transcoded-port port)
|
||
(error "port transcoders are not supported" port))
|
||
|
||
(define (port-position port)
|
||
"Return the offset (an integer) indicating where the next octet will be
|
||
read from/written to in @var{port}."
|
||
|
||
;; FIXME: We should raise an `&assertion' error when not supported.
|
||
(seek port 0 SEEK_CUR))
|
||
|
||
(define (set-port-position! port offset)
|
||
"Set the position where the next octet will be read from/written to
|
||
@var{port}."
|
||
|
||
;; FIXME: We should raise an `&assertion' error when not supported.
|
||
(seek port offset SEEK_SET))
|
||
|
||
(define (port-has-port-position? port)
|
||
"Return @code{#t} is @var{port} supports @code{port-position}."
|
||
(and (false-if-exception (port-position port)) #t))
|
||
|
||
(define (port-has-set-port-position!? port)
|
||
"Return @code{#t} is @var{port} supports @code{set-port-position!}."
|
||
(and (false-if-exception (set-port-position! port (port-position port)))
|
||
#t))
|
||
|
||
(define (call-with-port port proc)
|
||
"Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
|
||
@var{proc}. Return the return values of @var{proc}."
|
||
(dynamic-wind
|
||
(lambda ()
|
||
#t)
|
||
(lambda ()
|
||
(proc port))
|
||
(lambda ()
|
||
(close-port port))))
|
||
|
||
(define (open-string-input-port str)
|
||
"Open an input port that will read from @var{str}."
|
||
(with-fluids ((%default-port-encoding "UTF-8"))
|
||
(open-input-string str)))
|
||
|
||
(define (open-string-output-port)
|
||
"Return two values: an output port that will collect characters written to it
|
||
as a string, and a thunk to retrieve the characters associated with that port."
|
||
(let ((port (with-fluids ((%default-port-encoding "UTF-8"))
|
||
(open-output-string))))
|
||
(values port
|
||
(lambda () (get-output-string port)))))
|
||
|
||
;;; ports.scm ends here
|