* boot-9.scm (duplicate-handlers): Make sure the merge-generics
[bpt/guile.git] / ice-9 / buffered-input.scm
1 ;;;; buffered-input.scm --- construct a port from a buffered input reader
2 ;;;;
3 ;;;; Copyright (C) 2001 Free Software Foundation, Inc.
4 ;;;;
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 2, or (at your option)
8 ;;;; any later version.
9 ;;;;
10 ;;;; This program 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
13 ;;;; GNU General Public License for more details.
14 ;;;;
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this software; see the file COPYING. If not, write to
17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
18 ;;;; Boston, MA 02111-1307 USA
19 ;;;;
20 ;;;; As a special exception, the Free Software Foundation gives permission
21 ;;;; for additional uses of the text contained in its release of GUILE.
22 ;;;;
23 ;;;; The exception is that, if you link the GUILE library with other files
24 ;;;; to produce an executable, this does not by itself cause the
25 ;;;; resulting executable to be covered by the GNU General Public License.
26 ;;;; Your use of that executable is in no way restricted on account of
27 ;;;; linking the GUILE library code into it.
28 ;;;;
29 ;;;; This exception does not however invalidate any other reasons why
30 ;;;; the executable file might be covered by the GNU General Public License.
31 ;;;;
32 ;;;; This exception applies only to the code released by the
33 ;;;; Free Software Foundation under the name GUILE. If you copy
34 ;;;; code from other Free Software Foundation releases into a copy of
35 ;;;; GUILE, as the General Public License permits, the exception does
36 ;;;; not apply to the code that you add in this way. To avoid misleading
37 ;;;; anyone as to the status of such modified files, you must delete
38 ;;;; this exception notice from them.
39 ;;;;
40 ;;;; If you write modifications of your own for GUILE, it is your choice
41 ;;;; whether to permit this exception to apply to your modifications.
42 ;;;; If you do not wish that, delete this exception notice.
43
44 (define-module (ice-9 buffered-input)
45 #:export (make-buffered-input-port
46 make-line-buffered-input-port
47 set-buffered-input-continuation?!))
48
49 ;; @code{buffered-input-continuation?} is a property of the ports
50 ;; created by @code{make-line-buffered-input-port} that stores the
51 ;; read continuation flag for each such port.
52 (define buffered-input-continuation? (make-object-property))
53
54 (define (set-buffered-input-continuation?! port val)
55 "Set the read continuation flag for @var{port} to @var{val}.
56
57 See @code{make-buffered-input-port} for the meaning and use of this
58 flag."
59 (set! (buffered-input-continuation? port) val))
60
61 (define (make-buffered-input-port reader)
62 "Construct a line-buffered input port from the specified @var{reader}.
63 @var{reader} should be a procedure of one argument that somehow reads
64 a chunk of input and returns it as a string.
65
66 The port created by @code{make-buffered-input-port} does @emph{not}
67 interpolate any additional characters between the strings returned by
68 @var{reader}.
69
70 @var{reader} should take a boolean @var{continuation?} argument.
71 @var{continuation?} indicates whether @var{reader} is being called to
72 start a logically new read operation (in which case
73 @var{continuation?} is @code{#f}) or to continue a read operation for
74 which some input has already been read (in which case
75 @var{continuation?} is @code{#t}). Some @var{reader} implementations
76 use the @var{continuation?} argument to determine what prompt to
77 display to the user.
78
79 The new/continuation distinction is largely an application-level
80 concept: @code{set-buffered-input-continuation?!} allows an
81 application to specify when a read operation is considered to be new.
82 But note that if there is non-whitespace data already buffered in the
83 port when a new read operation starts, this data will be read before
84 the first call to @var{reader}, and so @var{reader} will be called
85 with @var{continuation?} set to @code{#t}."
86 (let ((read-string "")
87 (string-index -1))
88 (letrec ((get-character
89 (lambda ()
90 (cond
91 ((eof-object? read-string)
92 read-string)
93 ((>= string-index (string-length read-string))
94 (set! string-index -1)
95 (get-character))
96 ((= string-index -1)
97 (set! read-string (reader (buffered-input-continuation? port)))
98 (set! string-index 0)
99 (if (not (eof-object? read-string))
100 (get-character)
101 read-string))
102 (else
103 (let ((res (string-ref read-string string-index)))
104 (set! string-index (+ 1 string-index))
105 (if (not (char-whitespace? res))
106 (set! (buffered-input-continuation? port) #t))
107 res)))))
108 (input-waiting
109 (lambda ()
110 (if (eof-object? read-string)
111 1
112 (- (string-length read-string) string-index))))
113 (port #f))
114 (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r"))
115 (set! (buffered-input-continuation? port) #f)
116 port)))
117
118 (define (make-line-buffered-input-port reader)
119 "Construct a line-buffered input port from the specified @var{reader}.
120 @var{reader} should be a procedure of one argument that somehow reads
121 a line of input and returns it as a string @emph{without} the
122 terminating newline character.
123
124 The port created by @code{make-line-buffered-input-port} automatically
125 interpolates a newline character after each string returned by
126 @var{reader}.
127
128 @var{reader} should take a boolean @var{continuation?} argument. For
129 the meaning and use of this argument, see
130 @code{make-buffered-input-port}."
131 (make-buffered-input-port (lambda (continuation?)
132 (let ((str (reader continuation?)))
133 (if (eof-object? str)
134 str
135 (string-append str "\n"))))))
136
137 ;;; buffered-input.scm ends here