3 ;;;; Copyright (C) 1996, 1998, 2001 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 (define-module (ice-9 lineio)
23 :use-module (ice-9 readline)
24 :export (unread-string read-string lineio-port?
25 make-line-buffering-input-port))
28 ;;; {Line Buffering Input Ports}
30 ;;; [This is a work-around to get past certain deficiencies in the capabilities
31 ;;; of ports. Eventually, ports should be fixed and this module nuked.]
33 ;;; A line buffering input port supports:
35 ;;; read-string which returns the next line of input
36 ;;; unread-string which pushes a line back onto the stream
38 ;;; The implementation of unread-string is kind of limited; it doesn't
39 ;;; interact properly with unread-char, or any of the other port
40 ;;; reading functions. Only read-string will get you back the things that
41 ;;; unread-string accepts.
43 ;;; Normally a "line" is all characters up to and including a newline.
44 ;;; If lines are put back using unread-string, they can be broken arbitrarily
45 ;;; -- that is, read-string returns strings passed to unread-string (or
46 ;;; shared substrings of them).
50 ;; unread-string port str
51 ;; Read (or buffer) a line from PORT.
53 ;; Not all ports support these functions -- only those with
54 ;; 'unread-string and 'read-string properties, bound to hooks
55 ;; implementing these functions.
57 (define (unread-string str line-buffering-input-port)
58 ((object-property line-buffering-input-port 'unread-string) str))
61 (define (read-string line-buffering-input-port)
62 ((object-property line-buffering-input-port 'read-string)))
65 (define (lineio-port? port)
66 (not (not (object-property port 'read-string))))
68 ;; make-line-buffering-input-port port
69 ;; Return a wrapper for PORT. The wrapper handles read-string/unread-string.
71 ;; The port returned by this function reads newline terminated lines from PORT.
72 ;; It buffers these characters internally, and parsels them out via calls
73 ;; to read-char, read-string, and unread-string.
76 (define (make-line-buffering-input-port underlying-port)
77 (let* (;; buffers - a list of strings put back by unread-string or cached
82 ;; getc - return the next character from a buffer or from the underlying
87 (read-char underlying-port)
88 (let ((c (string-ref (car buffers))))
89 (if (= 1 (string-length (car buffers)))
90 (set! buffers (cdr buffers))
91 (set-car! buffers (substring (car buffers) 1)))
94 (propogate-close (lambda () (close-port underlying-port)))
96 (self (make-soft-port (vector #f #f #f getc propogate-close) "r"))
98 (unread-string (lambda (str)
99 (and (< 0 (string-length str))
100 (set! buffers (cons str buffers)))))
102 (read-string (lambda ()
104 ((not (null? buffers))
105 (let ((answer (car buffers)))
106 (set! buffers (cdr buffers))
109 (read-line underlying-port 'concat)))))) ;handle-newline->concat
111 (set-object-property! self 'unread-string unread-string)
112 (set-object-property! self 'read-string read-string)