3 ;;;; Copyright (C) 1996, 1998, 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.
47 (define-module (ice-9 lineio)
48 :use-module (ice-9 readline))
51 ;;; {Line Buffering Input Ports}
53 ;;; [This is a work-around to get past certain deficiencies in the capabilities
54 ;;; of ports. Eventually, ports should be fixed and this module nuked.]
56 ;;; A line buffering input port supports:
58 ;;; read-string which returns the next line of input
59 ;;; unread-string which pushes a line back onto the stream
61 ;;; The implementation of unread-string is kind of limited; it doesn't
62 ;;; interact properly with unread-char, or any of the other port
63 ;;; reading functions. Only read-string will get you back the things that
64 ;;; unread-string accepts.
66 ;;; Normally a "line" is all characters up to and including a newline.
67 ;;; If lines are put back using unread-string, they can be broken arbitrarily
68 ;;; -- that is, read-string returns strings passed to unread-string (or
69 ;;; shared substrings of them).
73 ;; unread-string port str
74 ;; Read (or buffer) a line from PORT.
76 ;; Not all ports support these functions -- only those with
77 ;; 'unread-string and 'read-string properties, bound to hooks
78 ;; implementing these functions.
80 (define-public (unread-string str line-buffering-input-port)
81 ((object-property line-buffering-input-port 'unread-string) str))
84 (define-public (read-string line-buffering-input-port)
85 ((object-property line-buffering-input-port 'read-string)))
88 (define-public (lineio-port? port)
89 (not (not (object-property port 'read-string))))
91 ;; make-line-buffering-input-port port
92 ;; Return a wrapper for PORT. The wrapper handles read-string/unread-string.
94 ;; The port returned by this function reads newline terminated lines from PORT.
95 ;; It buffers these characters internally, and parsels them out via calls
96 ;; to read-char, read-string, and unread-string.
99 (define-public (make-line-buffering-input-port underlying-port)
100 (let* (;; buffers - a list of strings put back by unread-string or cached
105 ;; getc - return the next character from a buffer or from the underlying
110 (read-char underlying-port)
111 (let ((c (string-ref (car buffers))))
112 (if (= 1 (string-length (car buffers)))
113 (set! buffers (cdr buffers))
114 (set-car! buffers (substring (car buffers) 1)))
117 (propogate-close (lambda () (close-port underlying-port)))
119 (self (make-soft-port (vector #f #f #f getc propogate-close) "r"))
121 (unread-string (lambda (str)
122 (and (< 0 (string-length str))
123 (set! buffers (cons str buffers)))))
125 (read-string (lambda ()
127 ((not (null? buffers))
128 (let ((answer (car buffers)))
129 (set! buffers (cdr buffers))
132 (read-line underlying-port 'concat)))))) ;handle-newline->concat
134 (set-object-property! self 'unread-string unread-string)
135 (set-object-property! self 'read-string read-string)