module/ice-9/buffered-input.scm

   1 ;;;; buffered-input.scm --- construct a port from a buffered input reader
   2 ;;;;
   3 ;;;;    Copyright (C) 2001, 2006 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 (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 -1))
  63     (letrec ((get-character
  64               (lambda ()
  65                 (cond
  66                  ((eof-object? read-string)
  67                   read-string)
  68                  ((>= string-index (string-length read-string))
  69                   (set! string-index -1)
  70                   (get-character))
  71                  ((= string-index -1)
  72                   (set! read-string (reader (buffered-input-continuation? port)))
  73                   (set! string-index 0)
  74                   (if (not (eof-object? read-string))
  75                       (get-character)
  76                       read-string))
  77                  (else
  78                   (let ((res (string-ref read-string string-index)))
  79                     (set! string-index (+ 1 string-index))
  80                     (if (not (char-whitespace? res))
  81                         (set! (buffered-input-continuation? port) #t))
  82                     res)))))
  83              (input-waiting
  84               (lambda ()
  85                 (if (eof-object? read-string)
  86                     1
  87                     (- (string-length read-string) string-index))))
  88              (port #f))
  89       (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r"))
  90       (set! (buffered-input-continuation? port) #f)
  91       port)))
  92
  93 (define (make-line-buffered-input-port reader)
  94   "Construct a line-buffered input port from the specified @var{reader}.
  95 @var{reader} should be a procedure of one argument that somehow reads
  96 a line of input and returns it as a string @emph{without} the
  97 terminating newline character.
  98
  99 The port created by @code{make-line-buffered-input-port} automatically
 100 interpolates a newline character after each string returned by
 101 @var{reader}.
 102
 103 @var{reader} should take a boolean @var{continuation?} argument.  For
 104 the meaning and use of this argument, see
 105 @code{make-buffered-input-port}."
 106   (make-buffered-input-port (lambda (continuation?)
 107                               (let ((str (reader continuation?)))
 108                                 (if (eof-object? str)
 109                                     str
 110                                     (string-append str "\n"))))))
 111
 112 ;;; buffered-input.scm ends here