Commit | Line | Data |
---|---|---|
9d774814 GH |
1 | ;;; installed-scm-file |
2 | ||
a41b07a3 LC |
3 | ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013, |
4 | ;;;; 2014 Free Software Foundation, Inc. | |
5 | ;;;; | |
73be1d9e MV |
6 | ;;;; This library is free software; you can redistribute it and/or |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 9 | ;;;; version 3 of the License, or (at your option) any later version. |
9d774814 | 10 | ;;;; |
73be1d9e | 11 | ;;;; This library is distributed in the hope that it will be useful, |
9d774814 | 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
14 | ;;;; Lesser General Public License for more details. | |
9d774814 | 15 | ;;;; |
73be1d9e MV |
16 | ;;;; You should have received a copy of the GNU Lesser General Public |
17 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
9d774814 GH |
19 | ;;;; |
20 | \f | |
21 | ||
6d36532c GH |
22 | ;;; This is the Scheme part of the module for delimited I/O. It's |
23 | ;;; similar to (scsh rdelim) but somewhat incompatible. | |
9d774814 | 24 | |
1a179b03 | 25 | (define-module (ice-9 rdelim) |
32512226 AW |
26 | #:export (read-line |
27 | read-line! | |
28 | read-delimited | |
29 | read-delimited! | |
5a35d42a AW |
30 | read-string |
31 | read-string! | |
32512226 AW |
32 | %read-delimited! |
33 | %read-line | |
34 | write-line)) | |
35 | ||
9d774814 | 36 | |
43fd4402 MV |
37 | (%init-rdelim-builtins) |
38 | ||
32512226 | 39 | (define* (read-line! string #:optional (port current-input-port)) |
9d774814 GH |
40 | ;; corresponds to SCM_LINE_INCREMENTORS in libguile. |
41 | (define scm-line-incrementors "\n") | |
32512226 AW |
42 | (let* ((rv (%read-delimited! scm-line-incrementors |
43 | string | |
44 | #t | |
45 | port)) | |
46 | (terminator (car rv)) | |
47 | (nchars (cdr rv))) | |
48 | (cond ((and (= nchars 0) | |
49 | (eof-object? terminator)) | |
50 | terminator) | |
51 | ((not terminator) #f) | |
52 | (else nchars)))) | |
9d774814 | 53 | |
32512226 AW |
54 | (define* (read-delimited! delims buf #:optional |
55 | (port (current-input-port)) (handle-delim 'trim) | |
56 | (start 0) (end (string-length buf))) | |
57 | (let* ((rv (%read-delimited! delims | |
58 | buf | |
59 | (not (eq? handle-delim 'peek)) | |
60 | port | |
61 | start | |
62 | end)) | |
63 | (terminator (car rv)) | |
64 | (nchars (cdr rv))) | |
65 | (cond ((or (not terminator) ; buffer filled | |
66 | (eof-object? terminator)) | |
67 | (if (zero? nchars) | |
68 | (if (eq? handle-delim 'split) | |
69 | (cons terminator terminator) | |
70 | terminator) | |
71 | (if (eq? handle-delim 'split) | |
72 | (cons nchars terminator) | |
73 | nchars))) | |
74 | (else | |
75 | (case handle-delim | |
76 | ((trim peek) nchars) | |
77 | ((concat) (string-set! buf (+ nchars start) terminator) | |
78 | (+ nchars 1)) | |
79 | ((split) (cons nchars terminator)) | |
80 | (else (error "unexpected handle-delim value: " | |
81 | handle-delim))))))) | |
9d774814 | 82 | |
32512226 AW |
83 | (define* (read-delimited delims #:optional (port (current-input-port)) |
84 | (handle-delim 'trim)) | |
85 | (let loop ((substrings '()) | |
86 | (total-chars 0) | |
87 | (buf-size 100)) ; doubled each time through. | |
88 | (let* ((buf (make-string buf-size)) | |
89 | (rv (%read-delimited! delims | |
90 | buf | |
91 | (not (eq? handle-delim 'peek)) | |
92 | port)) | |
93 | (terminator (car rv)) | |
94 | (nchars (cdr rv)) | |
32512226 | 95 | (new-total (+ total-chars nchars))) |
8556760c AW |
96 | (cond |
97 | ((not terminator) | |
98 | ;; buffer filled. | |
99 | (loop (cons (substring buf 0 nchars) substrings) | |
100 | new-total | |
101 | (* buf-size 2))) | |
102 | ((and (eof-object? terminator) (zero? new-total)) | |
103 | (if (eq? handle-delim 'split) | |
104 | (cons terminator terminator) | |
105 | terminator)) | |
106 | (else | |
107 | (let ((joined | |
108 | (string-concatenate-reverse | |
109 | (cons (substring buf 0 nchars) substrings)))) | |
110 | (case handle-delim | |
111 | ((concat) | |
112 | (if (eof-object? terminator) | |
113 | joined | |
114 | (string-append joined (string terminator)))) | |
115 | ((trim peek) joined) | |
116 | ((split) (cons joined terminator)) | |
117 | (else (error "unexpected handle-delim value: " | |
118 | handle-delim))))))))) | |
9d774814 | 119 | |
5a35d42a AW |
120 | (define-syntax-rule (check-arg exp message arg ...) |
121 | (unless exp | |
122 | (error message arg ...))) | |
123 | ||
124 | (define (index? n) | |
125 | (and (integer? n) (exact? n) (>= n 0))) | |
126 | ||
127 | (define* (read-string! buf #:optional | |
128 | (port (current-input-port)) | |
129 | (start 0) (end (string-length buf))) | |
130 | "Read all of the characters out of PORT and write them to BUF. | |
131 | Returns the number of characters read. | |
132 | ||
133 | This function only reads out characters from PORT if it will be able to | |
134 | write them to BUF. That is to say, if BUF is smaller than the number of | |
135 | available characters, then BUF will be filled, and characters will be | |
136 | left in the port." | |
137 | (check-arg (string? buf) "not a string" buf) | |
138 | (check-arg (index? start) "bad index" start) | |
139 | (check-arg (index? end) "bad index" end) | |
140 | (check-arg (<= start end) "start beyond end" start end) | |
141 | (check-arg (<= end (string-length buf)) "end beyond string length" end) | |
142 | (let lp ((n start)) | |
143 | (if (< n end) | |
144 | (let ((c (read-char port))) | |
145 | (if (eof-object? c) | |
146 | (- n start) | |
147 | (begin | |
148 | (string-set! buf n c) | |
149 | (lp (1+ n))))) | |
150 | (- n start)))) | |
151 | ||
a41b07a3 LC |
152 | (define* read-string |
153 | (case-lambda* | |
154 | "Read all of the characters out of PORT and return them as a string. | |
7ca5500f AW |
155 | If the COUNT argument is present, treat it as a limit to the number of |
156 | characters to read. By default, there is no limit." | |
a41b07a3 LC |
157 | ((#:optional (port (current-input-port))) |
158 | ;; Fast path. | |
159 | ;; This creates more garbage than using 'string-set!' as in | |
160 | ;; 'read-string!', but currently that is faster nonetheless. | |
161 | (let loop ((chars '())) | |
162 | (let ((char (read-char port))) | |
163 | (if (eof-object? char) | |
164 | (list->string (reverse! chars)) | |
165 | (loop (cons char chars)))))) | |
166 | ((port count) | |
167 | ;; Slower path. | |
168 | (let loop ((chars '()) | |
169 | (total 0)) | |
170 | (let ((char (read-char port))) | |
171 | (if (or (eof-object? char) (>= total count)) | |
172 | (list->string (reverse chars)) | |
173 | (loop (cons char chars) (+ 1 total)))))))) | |
174 | ||
5a35d42a | 175 | |
9d774814 GH |
176 | ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string |
177 | ;;; from PORT. The return value depends on the value of HANDLE-DELIM, | |
178 | ;;; which may be one of the symbols `trim', `concat', `peek' and | |
179 | ;;; `split'. If it is `trim' (the default), the trailing newline is | |
180 | ;;; removed and the string is returned. If `concat', the string is | |
181 | ;;; returned with the trailing newline intact. If `peek', the newline | |
182 | ;;; is left in the input port buffer and the string is returned. If | |
183 | ;;; `split', the newline is split from the string and read-line | |
184 | ;;; returns a pair consisting of the truncated string and the newline. | |
185 | ||
32512226 AW |
186 | (define* (read-line #:optional (port (current-input-port)) |
187 | (handle-delim 'trim)) | |
188 | (let* ((line/delim (%read-line port)) | |
9d774814 GH |
189 | (line (car line/delim)) |
190 | (delim (cdr line/delim))) | |
191 | (case handle-delim | |
192 | ((trim) line) | |
193 | ((split) line/delim) | |
194 | ((concat) (if (and (string? line) (char? delim)) | |
195 | (string-append line (string delim)) | |
196 | line)) | |
197 | ((peek) (if (char? delim) | |
198 | (unread-char delim port)) | |
199 | line) | |
200 | (else | |
201 | (error "unexpected handle-delim value: " handle-delim))))) |