1;;; installed-scm-file
2
3;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013,
4;;;;   2014 Free Software Foundation, Inc.
5;;;;
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
9;;;; version 3 of the License, or (at your option) any later version.
10;;;;
11;;;; This library is distributed in the hope that it will be useful,
12;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14;;;; Lesser General Public License for more details.
15;;;;
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
18;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19;;;;
20
21
22;;; This is the Scheme part of the module for delimited I/O.  It's
23;;; similar to (scsh rdelim) but somewhat incompatible.
24
25(define-module (ice-9 rdelim)
26  #:export (read-line
27            read-line!
28            read-delimited
29            read-delimited!
30            read-string
31            read-string!
32            %read-delimited!
33            %read-line
34            write-line))
35
36
37(%init-rdelim-builtins)
38
39(define* (read-line! string #:optional (port current-input-port))
40  ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
41  (define scm-line-incrementors "\n")
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))))
53
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)))))))
82
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))
95           (new-total (+ total-chars nchars)))
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)))))))))
119
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.
131Returns the number of characters read.
132
133This function only reads out characters from PORT if it will be able to
134write them to BUF.  That is to say, if BUF is smaller than the number of
135available characters, then BUF will be filled, and characters will be
136left 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
152(define* read-string
153  (case-lambda*
154   "Read all of the characters out of PORT and return them as a string.
155If the COUNT argument is present, treat it as a limit to the number of
156characters to read.  By default, there is no limit."
157   ((#:optional (port (current-input-port)))
158    ;; Fast path.
159    (let loop ((head (make-string 30)) (pos 0) (tail '()))
160      (let ((char (read-char port)))
161        (cond
162         ((eof-object? char)
163          (let ((head (substring head 0 pos)))
164            (if (null? tail)
165                (substring head 0 pos)
166                (string-concatenate-reverse tail head pos))))
167         (else
168          (string-set! head pos char)
169          (if (< (1+ pos) (string-length head))
170              (loop head (1+ pos) tail)
171              (loop (make-string (* (string-length head) 2)) 0
172                    (cons head tail))))))))
173   ((port count)
174    ;; Slower path.
175    (let loop ((chars '())
176               (total 0))
177      (let ((char (read-char port)))
178        (if (or (eof-object? char) (>= total count))
179            (list->string (reverse chars))
180            (loop (cons char chars) (+ 1 total))))))))
181
182
183;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
184;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
185;;; which may be one of the symbols `trim', `concat', `peek' and
186;;; `split'.  If it is `trim' (the default), the trailing newline is
187;;; removed and the string is returned.  If `concat', the string is
188;;; returned with the trailing newline intact.  If `peek', the newline
189;;; is left in the input port buffer and the string is returned.  If
190;;; `split', the newline is split from the string and read-line
191;;; returns a pair consisting of the truncated string and the newline.
192
193(define* (read-line #:optional (port (current-input-port))
194                    (handle-delim 'trim))
195  (let* ((line/delim	(%read-line port))
196	 (line		(car line/delim))
197	 (delim		(cdr line/delim)))
198    (case handle-delim
199      ((trim) line)
200      ((split) line/delim)
201      ((concat) (if (and (string? line) (char? delim))
202		    (string-append line (string delim))
203		    line))
204      ((peek) (if (char? delim)
205		  (unread-char delim port))
206	      line)
207      (else
208       (error "unexpected handle-delim value: " handle-delim)))))
209