guile/module/ice-9/rdelim.scm

;;; installed-scm-file

;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 


;;; This is the Scheme part of the module for delimited I/O.  It's
;;; similar to (scsh rdelim) but somewhat incompatible.

(define-module (ice-9 rdelim)
  #:export (read-line
            read-line!
            read-delimited
            read-delimited!
            %read-delimited!
            %read-line
            write-line))


(%init-rdelim-builtins)

(define* (read-line! string #:optional (port current-input-port))
  ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
  (define scm-line-incrementors "\n")
  (let* ((rv (%read-delimited! scm-line-incrementors
                               string
                               #t
                               port))
         (terminator (car rv))
         (nchars (cdr rv)))
    (cond ((and (= nchars 0)
                (eof-object? terminator))
           terminator)
          ((not terminator) #f)
          (else nchars))))

(define* (read-delimited! delims buf #:optional
                          (port (current-input-port)) (handle-delim 'trim)
                          (start 0) (end (string-length buf)))
  (let* ((rv (%read-delimited! delims
                               buf
                               (not (eq? handle-delim 'peek))
                               port
                               start
                               end))
         (terminator (car rv))
         (nchars (cdr rv)))
    (cond ((or (not terminator)         ; buffer filled
               (eof-object? terminator))
           (if (zero? nchars)
               (if (eq? handle-delim 'split)
                   (cons terminator terminator)
                   terminator)
               (if (eq? handle-delim 'split)
                   (cons nchars terminator)
                   nchars)))
          (else
           (case handle-delim
             ((trim peek) nchars)
             ((concat) (string-set! buf (+ nchars start) terminator)
              (+ nchars 1))
             ((split) (cons nchars terminator))
             (else (error "unexpected handle-delim value: " 
                          handle-delim)))))))
  
(define* (read-delimited delims #:optional (port (current-input-port))
                         (handle-delim 'trim))
  (let loop ((substrings '())
             (total-chars 0)
             (buf-size 100))		; doubled each time through.
    (let* ((buf (make-string buf-size))
           (rv (%read-delimited! delims
                                 buf
                                 (not (eq? handle-delim 'peek))
                                 port))
           (terminator (car rv))
           (nchars (cdr rv))
           (new-total (+ total-chars nchars)))
      (cond
       ((not terminator)
        ;; buffer filled.
        (loop (cons (substring buf 0 nchars) substrings)
              new-total
              (* buf-size 2)))
       ((and (eof-object? terminator) (zero? new-total))
        (if (eq? handle-delim 'split)
            (cons terminator terminator)
            terminator))
       (else
        (let ((joined
               (string-concatenate-reverse
                (cons (substring buf 0 nchars) substrings))))
          (case handle-delim
            ((concat)
             (if (eof-object? terminator)
                 joined
                 (string-append joined (string terminator))))
            ((trim peek) joined)
            ((split) (cons joined terminator))
            (else (error "unexpected handle-delim value: "
                         handle-delim)))))))))

;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
;;; which may be one of the symbols `trim', `concat', `peek' and
;;; `split'.  If it is `trim' (the default), the trailing newline is
;;; removed and the string is returned.  If `concat', the string is
;;; returned with the trailing newline intact.  If `peek', the newline
;;; is left in the input port buffer and the string is returned.  If
;;; `split', the newline is split from the string and read-line
;;; returns a pair consisting of the truncated string and the newline.

(define* (read-line #:optional (port (current-input-port))
                    (handle-delim 'trim))
  (let* ((line/delim	(%read-line port))
	 (line		(car line/delim))
	 (delim		(cdr line/delim)))
    (case handle-delim
      ((trim) line)
      ((split) line/delim)
      ((concat) (if (and (string? line) (char? delim))
		    (string-append line (string delim))
		    line))
      ((peek) (if (char? delim)
		  (unread-char delim port))
	      line)
      (else
       (error "unexpected handle-delim value: " handle-delim)))))