3 ;;;; Copyright (C) 1996, 1998 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
23 (define-module (ice-9 lineio))
26 ;;; {Line Buffering Input Ports}
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.]
31 ;;; A line buffering input port supports:
33 ;;; read-string which returns the next line of input
34 ;;; unread-string which pushes a line back onto the stream
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.
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).
48 ;; unread-string port str
49 ;; Read (or buffer) a line from PORT.
51 ;; Not all ports support these functions -- only those with
52 ;; 'unread-string and 'read-string properties, bound to hooks
53 ;; implementing these functions.
55 (define-public (unread-string str line-buffering-input-port)
56 ((object-property line-buffering-input-port 'unread-string) str))
59 (define-public (read-string line-buffering-input-port)
60 ((object-property line-buffering-input-port 'read-string)))
63 (define-public (lineio-port? port)
64 (not (not (object-property port 'read-string))))
66 ;; make-line-buffering-input-port port
67 ;; Return a wrapper for PORT. The wrapper handles read-string/unread-string.
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.
74 (define-public (make-line-buffering-input-port underlying-port)
75 (let* (;; buffers - a list of strings put back by unread-string or cached
80 ;; getc - return the next character from a buffer or from the underlying
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)))
92 (propogate-close (lambda () (close-port underlying-port)))
94 (self (make-soft-port (vector #f #f #f getc propogate-close) "r"))
96 (unread-string (lambda (str)
97 (and (< 0 (string-length str))
98 (set! buffers (cons str buffers)))))
100 (read-string (lambda ()
102 ((not (null? buffers))
103 (let ((answer (car buffers)))
104 (set! buffers (cdr buffers))
107 (read-line underlying-port 'concat)))))) ;handle-newline->concat
109 (set-object-property! self 'unread-string unread-string)
110 (set-object-property! self 'read-string read-string)