Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | ;;; installed-scm-file |
2 | ||
cd5fea8d | 3 | ;;;; Copyright (C) 1996, 1998, 2001, 2003, 2006 Free Software Foundation, Inc. |
0f2d19dd | 4 | ;;;; |
73be1d9e MV |
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 | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
0f2d19dd | 9 | ;;;; |
73be1d9e | 10 | ;;;; This library is distributed in the hope that it will be useful, |
0f2d19dd | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
0f2d19dd | 14 | ;;;; |
73be1d9e MV |
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 | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
0f2d19dd JB |
18 | ;;;; |
19 | ||
20 | \f | |
21 | ||
9d774814 | 22 | (define-module (ice-9 lineio) |
7f171dbf | 23 | :use-module (ice-9 rdelim) |
1a179b03 MD |
24 | :export (unread-string read-string lineio-port? |
25 | make-line-buffering-input-port)) | |
0f2d19dd JB |
26 | |
27 | \f | |
28 | ;;; {Line Buffering Input Ports} | |
29 | ;;; | |
30 | ;;; [This is a work-around to get past certain deficiencies in the capabilities | |
31 | ;;; of ports. Eventually, ports should be fixed and this module nuked.] | |
32 | ;;; | |
33 | ;;; A line buffering input port supports: | |
34 | ;;; | |
35 | ;;; read-string which returns the next line of input | |
36 | ;;; unread-string which pushes a line back onto the stream | |
95bfa948 JB |
37 | ;;; |
38 | ;;; The implementation of unread-string is kind of limited; it doesn't | |
39 | ;;; interact properly with unread-char, or any of the other port | |
40 | ;;; reading functions. Only read-string will get you back the things that | |
41 | ;;; unread-string accepts. | |
0f2d19dd JB |
42 | ;;; |
43 | ;;; Normally a "line" is all characters up to and including a newline. | |
44 | ;;; If lines are put back using unread-string, they can be broken arbitrarily | |
45 | ;;; -- that is, read-string returns strings passed to unread-string (or | |
46 | ;;; shared substrings of them). | |
47 | ;;; | |
48 | ||
49 | ;; read-string port | |
50 | ;; unread-string port str | |
51 | ;; Read (or buffer) a line from PORT. | |
52 | ;; | |
53 | ;; Not all ports support these functions -- only those with | |
54 | ;; 'unread-string and 'read-string properties, bound to hooks | |
55 | ;; implementing these functions. | |
56 | ;; | |
1a179b03 | 57 | (define (unread-string str line-buffering-input-port) |
0f2d19dd JB |
58 | ((object-property line-buffering-input-port 'unread-string) str)) |
59 | ||
60 | ;; | |
1a179b03 | 61 | (define (read-string line-buffering-input-port) |
0f2d19dd JB |
62 | ((object-property line-buffering-input-port 'read-string))) |
63 | ||
64 | ||
1a179b03 | 65 | (define (lineio-port? port) |
0f2d19dd JB |
66 | (not (not (object-property port 'read-string)))) |
67 | ||
68 | ;; make-line-buffering-input-port port | |
69 | ;; Return a wrapper for PORT. The wrapper handles read-string/unread-string. | |
70 | ;; | |
71 | ;; The port returned by this function reads newline terminated lines from PORT. | |
72 | ;; It buffers these characters internally, and parsels them out via calls | |
73 | ;; to read-char, read-string, and unread-string. | |
74 | ;; | |
75 | ||
1a179b03 | 76 | (define (make-line-buffering-input-port underlying-port) |
0f2d19dd JB |
77 | (let* (;; buffers - a list of strings put back by unread-string or cached |
78 | ;; using read-line. | |
79 | ;; | |
80 | (buffers '()) | |
81 | ||
82 | ;; getc - return the next character from a buffer or from the underlying | |
83 | ;; port. | |
84 | ;; | |
85 | (getc (lambda () | |
86 | (if (not buffers) | |
87 | (read-char underlying-port) | |
c7f670b8 | 88 | (let ((c (string-ref (car buffers) 0))) |
0f2d19dd JB |
89 | (if (= 1 (string-length (car buffers))) |
90 | (set! buffers (cdr buffers)) | |
4e15fee8 | 91 | (set-car! buffers (substring (car buffers) 1))) |
0f2d19dd JB |
92 | c)))) |
93 | ||
94 | (propogate-close (lambda () (close-port underlying-port))) | |
95 | ||
96 | (self (make-soft-port (vector #f #f #f getc propogate-close) "r")) | |
97 | ||
98 | (unread-string (lambda (str) | |
99 | (and (< 0 (string-length str)) | |
95bfa948 | 100 | (set! buffers (cons str buffers))))) |
0f2d19dd JB |
101 | |
102 | (read-string (lambda () | |
103 | (cond | |
b1646914 JB |
104 | ((not (null? buffers)) |
105 | (let ((answer (car buffers))) | |
106 | (set! buffers (cdr buffers)) | |
107 | answer)) | |
b1646914 | 108 | (else |
95bfa948 | 109 | (read-line underlying-port 'concat)))))) ;handle-newline->concat |
0f2d19dd JB |
110 | |
111 | (set-object-property! self 'unread-string unread-string) | |
112 | (set-object-property! self 'read-string read-string) | |
113 | self)) | |
114 | ||
115 |