guile18/ice-9/rdelim.scm

   1 ;;; installed-scm-file
   2
   3 ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
   4 ;;;;
   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.
   9 ;;;;
  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.
  14 ;;;;
  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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 ;;;;
  19 \f
  20
  21 ;;; This is the Scheme part of the module for delimited I/O.  It's
  22 ;;; similar to (scsh rdelim) but somewhat incompatible.
  23
  24 (define-module (ice-9 rdelim)
  25   :export (read-line read-line! read-delimited read-delimited!
  26            %read-delimited! %read-line write-line)  ; C
  27   )
  28
  29 (%init-rdelim-builtins)
  30
  31 (define (read-line! string . maybe-port)
  32   ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
  33   (define scm-line-incrementors "\n")
  34
  35   (let* ((port (if (pair? maybe-port)
  36                    (car maybe-port)
  37                    (current-input-port))))
  38     (let* ((rv (%read-delimited! scm-line-incrementors
  39                                  string
  40                                  #t
  41                                  port))
  42            (terminator (car rv))
  43            (nchars (cdr rv)))
  44       (cond ((and (= nchars 0)
  45                   (eof-object? terminator))
  46              terminator)
  47             ((not terminator) #f)
  48             (else nchars)))))
  49
  50 (define (read-delimited! delims buf . args)
  51   (let* ((num-args (length args))
  52          (port (if (> num-args 0)
  53                    (car args)
  54                    (current-input-port)))
  55          (handle-delim (if (> num-args 1)
  56                            (cadr args)
  57                            'trim))
  58          (start (if (> num-args 2)
  59                     (caddr args)
  60                     0))
  61          (end (if (> num-args 3)
  62                   (cadddr args)
  63                   (string-length buf))))
  64     (let* ((rv (%read-delimited! delims
  65                                  buf
  66                                  (not (eq? handle-delim 'peek))
  67                                  port
  68                                  start
  69                                  end))
  70            (terminator (car rv))
  71            (nchars (cdr rv)))
  72       (cond ((or (not terminator)       ; buffer filled
  73                  (eof-object? terminator))
  74              (if (zero? nchars)
  75                  (if (eq? handle-delim 'split)
  76                      (cons terminator terminator)
  77                      terminator)
  78                  (if (eq? handle-delim 'split)
  79                      (cons nchars terminator)
  80                      nchars)))
  81             (else
  82              (case handle-delim
  83                ((trim peek) nchars)
  84                ((concat) (string-set! buf (+ nchars start) terminator)
  85                          (+ nchars 1))
  86                ((split) (cons nchars terminator))
  87                (else (error "unexpected handle-delim value: "
  88                             handle-delim))))))))
  89
  90 (define (read-delimited delims . args)
  91   (let* ((port (if (pair? args)
  92                    (let ((pt (car args)))
  93                      (set! args (cdr args))
  94                      pt)
  95                    (current-input-port)))
  96          (handle-delim (if (pair? args)
  97                            (car args)
  98                            'trim)))
  99     (let loop ((substrings '())
 100                (total-chars 0)
 101                (buf-size 100))          ; doubled each time through.
 102       (let* ((buf (make-string buf-size))
 103              (rv (%read-delimited! delims
 104                                    buf
 105                                    (not (eq? handle-delim 'peek))
 106                                    port))
 107              (terminator (car rv))
 108              (nchars (cdr rv))
 109              (join-substrings
 110               (lambda ()
 111                 (apply string-append
 112                        (reverse
 113                         (cons (if (and (eq? handle-delim 'concat)
 114                                        (not (eof-object? terminator)))
 115                                   (string terminator)
 116                                   "")
 117                               (cons (substring buf 0 nchars)
 118                                     substrings))))))
 119              (new-total (+ total-chars nchars)))
 120         (cond ((not terminator)
 121                ;; buffer filled.
 122                (loop (cons (substring buf 0 nchars) substrings)
 123                      new-total
 124                      (* buf-size 2)))
 125               ((eof-object? terminator)
 126                (if (zero? new-total)
 127                    (if (eq? handle-delim 'split)
 128                        (cons terminator terminator)
 129                        terminator)
 130                    (if (eq? handle-delim 'split)
 131                        (cons (join-substrings) terminator)
 132                        (join-substrings))))
 133               (else
 134                (case handle-delim
 135                    ((trim peek concat) (join-substrings))
 136                    ((split) (cons (join-substrings) terminator))
 137
 138
 139                    (else (error "unexpected handle-delim value: "
 140                                 handle-delim)))))))))
 141
 142 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 143 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
 144 ;;; which may be one of the symbols `trim', `concat', `peek' and
 145 ;;; `split'.  If it is `trim' (the default), the trailing newline is
 146 ;;; removed and the string is returned.  If `concat', the string is
 147 ;;; returned with the trailing newline intact.  If `peek', the newline
 148 ;;; is left in the input port buffer and the string is returned.  If
 149 ;;; `split', the newline is split from the string and read-line
 150 ;;; returns a pair consisting of the truncated string and the newline.
 151
 152 (define (read-line . args)
 153   (let* ((port          (if (null? args)
 154                             (current-input-port)
 155                             (car args)))
 156          (handle-delim  (if (> (length args) 1)
 157                             (cadr args)
 158                             'trim))
 159          (line/delim    (%read-line port))
 160          (line          (car line/delim))
 161          (delim         (cdr line/delim)))
 162     (case handle-delim
 163       ((trim) line)
 164       ((split) line/delim)
 165       ((concat) (if (and (string? line) (char? delim))
 166                     (string-append line (string delim))
 167                     line))
 168       ((peek) (if (char? delim)
 169                   (unread-char delim port))
 170               line)
 171       (else
 172        (error "unexpected handle-delim value: " handle-delim)))))