| 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 |