module/ice-9/buffered-input.scm

   1 ;;;; buffered-input.scm --- construct a port from a buffered input reader
   2 ;;;;
   3 ;;;;    Copyright (C) 2001, 2006, 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 (define-module (ice-9 buffered-input)
  20   #:export (make-buffered-input-port
  21             make-line-buffered-input-port
  22             set-buffered-input-continuation?!))
  23
  24 ;; @code{buffered-input-continuation?} is a property of the ports
  25 ;; created by @code{make-line-buffered-input-port} that stores the
  26 ;; read continuation flag for each such port.
  27 (define buffered-input-continuation? (make-object-property))
  28
  29 (define (set-buffered-input-continuation?! port val)
  30   "Set the read continuation flag for @var{port} to @var{val}.
  31
  32 See @code{make-buffered-input-port} for the meaning and use of this
  33 flag."
  34   (set! (buffered-input-continuation? port) val))
  35
  36 (define (make-buffered-input-port reader)
  37   "Construct a line-buffered input port from the specified @var{reader}.
  38 @var{reader} should be a procedure of one argument that somehow reads
  39 a chunk of input and returns it as a string.
  40
  41 The port created by @code{make-buffered-input-port} does @emph{not}
  42 interpolate any additional characters between the strings returned by
  43 @var{reader}.
  44
  45 @var{reader} should take a boolean @var{continuation?} argument.
  46 @var{continuation?} indicates whether @var{reader} is being called to
  47 start a logically new read operation (in which case
  48 @var{continuation?} is @code{#f}) or to continue a read operation for
  49 which some input has already been read (in which case
  50 @var{continuation?} is @code{#t}).  Some @var{reader} implementations
  51 use the @var{continuation?} argument to determine what prompt to
  52 display to the user.
  53
  54 The new/continuation distinction is largely an application-level
  55 concept: @code{set-buffered-input-continuation?!} allows an
  56 application to specify when a read operation is considered to be new.
  57 But note that if there is non-whitespace data already buffered in the
  58 port when a new read operation starts, this data will be read before
  59 the first call to @var{reader}, and so @var{reader} will be called
  60 with @var{continuation?} set to @code{#t}."
  61   (let ((read-string "")
  62         (string-index 0))
  63     (letrec ((get-character
  64               (lambda ()
  65                 (if (< string-index (string-length read-string))
  66                     ;; Read a char.
  67                     (let ((res (string-ref read-string string-index)))
  68                       (set! string-index (+ 1 string-index))
  69                       (if (not (char-whitespace? res))
  70                           (set! (buffered-input-continuation? port) #t))
  71                       res)
  72                     ;; Fill the buffer.
  73                     (let ((x (reader (buffered-input-continuation? port))))
  74                       (cond
  75                        ((eof-object? x)
  76                         ;; Don't buffer the EOF object.
  77                         x)
  78                        (else
  79                         (set! read-string x)
  80                         (set! string-index 0)
  81                         (get-character)))))))
  82              (input-waiting
  83               (lambda ()
  84                 (- (string-length read-string) string-index)))
  85              (port #f))
  86       (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r"))
  87       (set! (buffered-input-continuation? port) #f)
  88       port)))
  89
  90 (define (make-line-buffered-input-port reader)
  91   "Construct a line-buffered input port from the specified @var{reader}.
  92 @var{reader} should be a procedure of one argument that somehow reads
  93 a line of input and returns it as a string @emph{without} the
  94 terminating newline character.
  95
  96 The port created by @code{make-line-buffered-input-port} automatically
  97 interpolates a newline character after each string returned by
  98 @var{reader}.
  99
 100 @var{reader} should take a boolean @var{continuation?} argument.  For
 101 the meaning and use of this argument, see
 102 @code{make-buffered-input-port}."
 103   (make-buffered-input-port (lambda (continuation?)
 104                               (let ((str (reader continuation?)))
 105                                 (if (eof-object? str)
 106                                     str
 107                                     (string-append str "\n"))))))
 108
 109 ;;; buffered-input.scm ends here