module/rnrs/io/ports.scm

   1 ;;;; ports.scm --- R6RS port API                    -*- coding: utf-8 -*-
   2
   3 ;;;;    Copyright (C) 2009, 2010 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Author: Ludovic Courtès <ludo@gnu.org>
  20
  21 ;;; Commentary:
  22 ;;;
  23 ;;; The I/O port API of the R6RS is provided by this module.  In many areas
  24 ;;; it complements or refines Guile's own historical port API.  For instance,
  25 ;;; it allows for binary I/O with bytevectors.
  26 ;;;
  27 ;;; Code:
  28
  29 (library (rnrs io ports (6))
  30   (export eof-object eof-object?
  31
  32           ;; input & output ports
  33           port? input-port? output-port?
  34           port-transcoder binary-port? transcoded-port
  35           port-position set-port-position!
  36           port-has-port-position? port-has-set-port-position!?
  37           call-with-port
  38
  39           ;; input ports
  40           open-bytevector-input-port
  41           open-string-input-port
  42           make-custom-binary-input-port
  43
  44           ;; binary input
  45           get-u8 lookahead-u8
  46           get-bytevector-n get-bytevector-n!
  47           get-bytevector-some get-bytevector-all
  48
  49           ;; output ports
  50           open-bytevector-output-port
  51           open-string-output-port
  52           make-custom-binary-output-port
  53
  54           ;; binary output
  55           put-u8 put-bytevector)
  56   (import (guile))
  57
  58 (load-extension (string-append "libguile-" (effective-version))
  59                 "scm_init_r6rs_ports")
  60
  61
  62 \f
  63 ;;;
  64 ;;; Input and output ports.
  65 ;;;
  66
  67 (define (port-transcoder port)
  68   (error "port transcoders are not supported" port))
  69
  70 (define (binary-port? port)
  71   ;; So far, we don't support transcoders other than the binary transcoder.
  72   #t)
  73
  74 (define (transcoded-port port)
  75   (error "port transcoders are not supported" port))
  76
  77 (define (port-position port)
  78   "Return the offset (an integer) indicating where the next octet will be
  79 read from/written to in @var{port}."
  80
  81   ;; FIXME: We should raise an `&assertion' error when not supported.
  82   (seek port 0 SEEK_CUR))
  83
  84 (define (set-port-position! port offset)
  85   "Set the position where the next octet will be read from/written to
  86 @var{port}."
  87
  88   ;; FIXME: We should raise an `&assertion' error when not supported.
  89   (seek port offset SEEK_SET))
  90
  91 (define (port-has-port-position? port)
  92   "Return @code{#t} is @var{port} supports @code{port-position}."
  93   (and (false-if-exception (port-position port)) #t))
  94
  95 (define (port-has-set-port-position!? port)
  96   "Return @code{#t} is @var{port} supports @code{set-port-position!}."
  97   (and (false-if-exception (set-port-position! port (port-position port)))
  98        #t))
  99
 100 (define (call-with-port port proc)
 101   "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
 102 @var{proc}.  Return the return values of @var{proc}."
 103   (dynamic-wind
 104       (lambda ()
 105         #t)
 106       (lambda ()
 107         (proc port))
 108       (lambda ()
 109         (close-port port))))
 110
 111 (define (open-string-input-port str)
 112   "Open an input port that will read from @var{str}."
 113   (with-fluids ((%default-port-encoding "UTF-8"))
 114     (open-input-string str)))
 115
 116 (define (open-string-output-port)
 117   "Return two values: an output port that will collect characters written to it
 118 as a string, and a thunk to retrieve the characters associated with that port."
 119   (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
 120                 (open-output-string))))
 121     (values port
 122             (lambda () (get-output-string port)))))
 123
 124 )
 125
 126 ;;; ports.scm ends here