module/rnrs/io/ports.scm

   1 ;;;; ports.scm --- R6RS port API
   2
   3 ;;;;    Copyright (C) 2009 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 2.1 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 (define-module (rnrs io ports)
  30   :re-export (eof-object? port? input-port? output-port?)
  31   :export (eof-object
  32
  33            ;; input & output ports
  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            make-custom-binary-input-port
  42
  43            ;; binary input
  44            get-u8 lookahead-u8
  45            get-bytevector-n get-bytevector-n!
  46            get-bytevector-some get-bytevector-all
  47
  48            ;; output ports
  49            open-bytevector-output-port
  50            make-custom-binary-output-port
  51
  52            ;; binary output
  53            put-u8 put-bytevector))
  54
  55 (load-extension "libguile" "scm_init_r6rs_ports")
  56
  57
  58 \f
  59 ;;;
  60 ;;; Input and output ports.
  61 ;;;
  62
  63 (define (port-transcoder port)
  64   (error "port transcoders are not supported" port))
  65
  66 (define (binary-port? port)
  67   ;; So far, we don't support transcoders other than the binary transcoder.
  68   #t)
  69
  70 (define (transcoded-port port)
  71   (error "port transcoders are not supported" port))
  72
  73 (define (port-position port)
  74   "Return the offset (an integer) indicating where the next octet will be
  75 read from/written to in @var{port}."
  76
  77   ;; FIXME: We should raise an `&assertion' error when not supported.
  78   (seek port 0 SEEK_CUR))
  79
  80 (define (set-port-position! port offset)
  81   "Set the position where the next octet will be read from/written to
  82 @var{port}."
  83
  84   ;; FIXME: We should raise an `&assertion' error when not supported.
  85   (seek port offset SEEK_SET))
  86
  87 (define (port-has-port-position? port)
  88   "Return @code{#t} is @var{port} supports @code{port-position}."
  89   (and (false-if-exception (port-position port)) #t))
  90
  91 (define (port-has-set-port-position!? port)
  92   "Return @code{#t} is @var{port} supports @code{set-port-position!}."
  93   (and (false-if-exception (set-port-position! port (port-position port)))
  94        #t))
  95
  96 (define (call-with-port port proc)
  97   "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
  98 @var{proc}.  Return the return values of @var{proc}."
  99   (dynamic-wind
 100       (lambda ()
 101         #t)
 102       (lambda ()
 103         (proc port))
 104       (lambda ()
 105         (close-port port))))
 106
 107 ;;; Local Variables:
 108 ;;; coding: latin-1
 109 ;;; End:
 110
 111 ;;; ports.scm ends here