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