3 ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
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
8 ;;;; version 2.1 of the License, or (at your option) any later version.
10 ;;;; This library 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 GNU
13 ;;;; Lesser General Public License for more details.
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
17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 ;;; This is the Scheme part of the module for delimited I/O. It's
22 ;;; similar to (scsh rdelim) but somewhat incompatible.
24 (define-module (ice-9 rdelim)
25 :export (read-line read-line! read-delimited read-delimited!
26 %read-delimited! %read-line write-line) ; C
29 (%init-rdelim-builtins)
31 (define (read-line! string . maybe-port)
32 ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
33 (define scm-line-incrementors "\n")
35 (let* ((port (if (pair? maybe-port)
37 (current-input-port))))
38 (let* ((rv (%read-delimited! scm-line-incrementors
44 (cond ((and (= nchars 0)
45 (eof-object? terminator))
50 (define (read-delimited! delims buf . args)
51 (let* ((num-args (length args))
52 (port (if (> num-args 0)
54 (current-input-port)))
55 (handle-delim (if (> num-args 1)
58 (start (if (> num-args 2)
61 (end (if (> num-args 3)
63 (string-length buf))))
64 (let* ((rv (%read-delimited! delims
66 (not (eq? handle-delim 'peek))
72 (cond ((or (not terminator) ; buffer filled
73 (eof-object? terminator))
75 (if (eq? handle-delim 'split)
76 (cons terminator terminator)
78 (if (eq? handle-delim 'split)
79 (cons nchars terminator)
84 ((concat) (string-set! buf (+ nchars start) terminator)
86 ((split) (cons nchars terminator))
87 (else (error "unexpected handle-delim value: "
90 (define (read-delimited delims . args)
91 (let* ((port (if (pair? args)
92 (let ((pt (car args)))
93 (set! args (cdr args))
95 (current-input-port)))
96 (handle-delim (if (pair? args)
99 (let loop ((substrings '())
101 (buf-size 100)) ; doubled each time through.
102 (let* ((buf (make-string buf-size))
103 (rv (%read-delimited! delims
105 (not (eq? handle-delim 'peek))
107 (terminator (car rv))
113 (cons (if (and (eq? handle-delim 'concat)
114 (not (eof-object? terminator)))
117 (cons (substring buf 0 nchars)
119 (new-total (+ total-chars nchars)))
120 (cond ((not terminator)
122 (loop (cons (substring buf 0 nchars) substrings)
125 ((eof-object? terminator)
126 (if (zero? new-total)
127 (if (eq? handle-delim 'split)
128 (cons terminator terminator)
130 (if (eq? handle-delim 'split)
131 (cons (join-substrings) terminator)
135 ((trim peek concat) (join-substrings))
136 ((split) (cons (join-substrings) terminator))
139 (else (error "unexpected handle-delim value: "
140 handle-delim)))))))))
142 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
143 ;;; from PORT. The return value depends on the value of HANDLE-DELIM,
144 ;;; which may be one of the symbols `trim', `concat', `peek' and
145 ;;; `split'. If it is `trim' (the default), the trailing newline is
146 ;;; removed and the string is returned. If `concat', the string is
147 ;;; returned with the trailing newline intact. If `peek', the newline
148 ;;; is left in the input port buffer and the string is returned. If
149 ;;; `split', the newline is split from the string and read-line
150 ;;; returns a pair consisting of the truncated string and the newline.
152 (define (read-line . args)
153 (let* ((port (if (null? args)
156 (handle-delim (if (> (length args) 1)
159 (line/delim (%read-line port))
160 (line (car line/delim))
161 (delim (cdr line/delim)))
165 ((concat) (if (and (string? line) (char? delim))
166 (string-append line (string delim))
168 ((peek) (if (char? delim)
169 (unread-char delim port))
172 (error "unexpected handle-delim value: " handle-delim)))))