3 ;;;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
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.
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.
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
17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
18 ;;;; Boston, MA 02111-1307 USA
20 ;;;; As a special exception, the Free Software Foundation gives permission
21 ;;;; for additional uses of the text contained in its release of GUILE.
23 ;;;; The exception is that, if you link the GUILE library with other files
24 ;;;; to produce an executable, this does not by itself cause the
25 ;;;; resulting executable to be covered by the GNU General Public License.
26 ;;;; Your use of that executable is in no way restricted on account of
27 ;;;; linking the GUILE library code into it.
29 ;;;; This exception does not however invalidate any other reasons why
30 ;;;; the executable file might be covered by the GNU General Public License.
32 ;;;; This exception applies only to the code released by the
33 ;;;; Free Software Foundation under the name GUILE. If you copy
34 ;;;; code from other Free Software Foundation releases into a copy of
35 ;;;; GUILE, as the General Public License permits, the exception does
36 ;;;; not apply to the code that you add in this way. To avoid misleading
37 ;;;; anyone as to the status of such modified files, you must delete
38 ;;;; this exception notice from them.
40 ;;;; If you write modifications of your own for GUILE, it is your choice
41 ;;;; whether to permit this exception to apply to your modifications.
42 ;;;; If you do not wish that, delete this exception notice.
46 ;;; This is the Scheme part of the module for delimited I/O. It's
47 ;;; similar to (scsh rdelim) but somewhat incompatible.
49 (define-module (ice-9 rdelim)
50 :export (read-line read-line! read-delimited read-delimited!
51 %read-delimited! %read-line write-line) ; C
54 (%init-rdelim-builtins)
56 (define (read-line! string . maybe-port)
57 ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
58 (define scm-line-incrementors "\n")
60 (let* ((port (if (pair? maybe-port)
62 (current-input-port))))
63 (let* ((rv (%read-delimited! scm-line-incrementors
69 (cond ((and (= nchars 0)
70 (eof-object? terminator))
75 (define (read-delimited! delims buf . args)
76 (let* ((num-args (length args))
77 (port (if (> num-args 0)
79 (current-input-port)))
80 (handle-delim (if (> num-args 1)
83 (start (if (> num-args 2)
86 (end (if (> num-args 3)
88 (string-length buf))))
89 (let* ((rv (%read-delimited! delims
91 (not (eq? handle-delim 'peek))
97 (cond ((or (not terminator) ; buffer filled
98 (eof-object? terminator))
100 (if (eq? handle-delim 'split)
101 (cons terminator terminator)
103 (if (eq? handle-delim 'split)
104 (cons nchars terminator)
109 ((concat) (string-set! buf (+ nchars start) terminator)
111 ((split) (cons nchars terminator))
112 (else (error "unexpected handle-delim value: "
115 (define (read-delimited delims . args)
116 (let* ((port (if (pair? args)
117 (let ((pt (car args)))
118 (set! args (cdr args))
120 (current-input-port)))
121 (handle-delim (if (pair? args)
124 (let loop ((substrings '())
126 (buf-size 100)) ; doubled each time through.
127 (let* ((buf (make-string buf-size))
128 (rv (%read-delimited! delims
130 (not (eq? handle-delim 'peek))
132 (terminator (car rv))
138 (cons (if (and (eq? handle-delim 'concat)
139 (not (eof-object? terminator)))
142 (cons (substring buf 0 nchars)
144 (new-total (+ total-chars nchars)))
145 (cond ((not terminator)
147 (loop (cons (substring buf 0 nchars) substrings)
150 ((eof-object? terminator)
151 (if (zero? new-total)
152 (if (eq? handle-delim 'split)
153 (cons terminator terminator)
155 (if (eq? handle-delim 'split)
156 (cons (join-substrings) terminator)
160 ((trim peek concat) (join-substrings))
161 ((split) (cons (join-substrings) terminator))
164 (else (error "unexpected handle-delim value: "
165 handle-delim)))))))))
167 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
168 ;;; from PORT. The return value depends on the value of HANDLE-DELIM,
169 ;;; which may be one of the symbols `trim', `concat', `peek' and
170 ;;; `split'. If it is `trim' (the default), the trailing newline is
171 ;;; removed and the string is returned. If `concat', the string is
172 ;;; returned with the trailing newline intact. If `peek', the newline
173 ;;; is left in the input port buffer and the string is returned. If
174 ;;; `split', the newline is split from the string and read-line
175 ;;; returns a pair consisting of the truncated string and the newline.
177 (define (read-line . args)
178 (let* ((port (if (null? args)
181 (handle-delim (if (> (length args) 1)
184 (line/delim (%read-line port))
185 (line (car line/delim))
186 (delim (cdr line/delim)))
190 ((concat) (if (and (string? line) (char? delim))
191 (string-append line (string delim))
193 ((peek) (if (char? delim)
194 (unread-char delim port))
197 (error "unexpected handle-delim value: " handle-delim)))))