module/ice-9/rdelim.scm

   1 ;;; installed-scm-file
   2
   3 ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 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 3 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
  26             read-line!
  27             read-delimited
  28             read-delimited!
  29             read-string
  30             read-string!
  31             %read-delimited!
  32             %read-line
  33             write-line))
  34
  35
  36 (%init-rdelim-builtins)
  37
  38 (define* (read-line! string #:optional (port current-input-port))
  39   ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
  40   (define scm-line-incrementors "\n")
  41   (let* ((rv (%read-delimited! scm-line-incrementors
  42                                string
  43                                #t
  44                                port))
  45          (terminator (car rv))
  46          (nchars (cdr rv)))
  47     (cond ((and (= nchars 0)
  48                 (eof-object? terminator))
  49            terminator)
  50           ((not terminator) #f)
  51           (else nchars))))
  52
  53 (define* (read-delimited! delims buf #:optional
  54                           (port (current-input-port)) (handle-delim 'trim)
  55                           (start 0) (end (string-length buf)))
  56   (let* ((rv (%read-delimited! delims
  57                                buf
  58                                (not (eq? handle-delim 'peek))
  59                                port
  60                                start
  61                                end))
  62          (terminator (car rv))
  63          (nchars (cdr rv)))
  64     (cond ((or (not terminator)         ; buffer filled
  65                (eof-object? terminator))
  66            (if (zero? nchars)
  67                (if (eq? handle-delim 'split)
  68                    (cons terminator terminator)
  69                    terminator)
  70                (if (eq? handle-delim 'split)
  71                    (cons nchars terminator)
  72                    nchars)))
  73           (else
  74            (case handle-delim
  75              ((trim peek) nchars)
  76              ((concat) (string-set! buf (+ nchars start) terminator)
  77               (+ nchars 1))
  78              ((split) (cons nchars terminator))
  79              (else (error "unexpected handle-delim value: "
  80                           handle-delim)))))))
  81
  82 (define* (read-delimited delims #:optional (port (current-input-port))
  83                          (handle-delim 'trim))
  84   (let loop ((substrings '())
  85              (total-chars 0)
  86              (buf-size 100))            ; doubled each time through.
  87     (let* ((buf (make-string buf-size))
  88            (rv (%read-delimited! delims
  89                                  buf
  90                                  (not (eq? handle-delim 'peek))
  91                                  port))
  92            (terminator (car rv))
  93            (nchars (cdr rv))
  94            (new-total (+ total-chars nchars)))
  95       (cond
  96        ((not terminator)
  97         ;; buffer filled.
  98         (loop (cons (substring buf 0 nchars) substrings)
  99               new-total
 100               (* buf-size 2)))
 101        ((and (eof-object? terminator) (zero? new-total))
 102         (if (eq? handle-delim 'split)
 103             (cons terminator terminator)
 104             terminator))
 105        (else
 106         (let ((joined
 107                (string-concatenate-reverse
 108                 (cons (substring buf 0 nchars) substrings))))
 109           (case handle-delim
 110             ((concat)
 111              (if (eof-object? terminator)
 112                  joined
 113                  (string-append joined (string terminator))))
 114             ((trim peek) joined)
 115             ((split) (cons joined terminator))
 116             (else (error "unexpected handle-delim value: "
 117                          handle-delim)))))))))
 118
 119 (define-syntax-rule (check-arg exp message arg ...)
 120   (unless exp
 121     (error message arg ...)))
 122
 123 (define (index? n)
 124   (and (integer? n) (exact? n) (>= n 0)))
 125
 126 (define* (read-string! buf #:optional
 127                        (port (current-input-port))
 128                        (start 0) (end (string-length buf)))
 129   "Read all of the characters out of PORT and write them to BUF.
 130 Returns the number of characters read.
 131
 132 This function only reads out characters from PORT if it will be able to
 133 write them to BUF.  That is to say, if BUF is smaller than the number of
 134 available characters, then BUF will be filled, and characters will be
 135 left in the port."
 136   (check-arg (string? buf) "not a string" buf)
 137   (check-arg (index? start) "bad index" start)
 138   (check-arg (index? end) "bad index" end)
 139   (check-arg (<= start end) "start beyond end" start end)
 140   (check-arg (<= end (string-length buf)) "end beyond string length" end)
 141   (let lp ((n start))
 142     (if (< n end)
 143         (let ((c (read-char port)))
 144           (if (eof-object? c)
 145               (- n start)
 146               (begin
 147                 (string-set! buf n c)
 148                 (lp (1+ n)))))
 149         (- n start))))
 150
 151 (define* (read-string #:optional (port (current-input-port)) (count #f))
 152   "Read all of the characters out of PORT and return them as a string.
 153 If the COUNT argument is present, treat it as a limit to the number of
 154 characters to read.  By default, there is no limit."
 155   (check-arg (or (not count) (index? count)) "bad count" count)
 156   (let loop ((substrings '())
 157              (total-chars 0)
 158              (buf-size 100))            ; doubled each time through.
 159     (let* ((buf (make-string (if count
 160                                  (min buf-size (- count total-chars))
 161                                  buf-size)))
 162            (nchars (read-string! buf port))
 163            (new-total (+ total-chars nchars)))
 164       (cond
 165        ((= nchars buf-size)
 166         ;; buffer filled.
 167         (loop (cons buf substrings) new-total (* buf-size 2)))
 168        (else
 169         (string-concatenate-reverse
 170          (cons (substring buf 0 nchars) substrings)))))))
 171
 172 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 173 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
 174 ;;; which may be one of the symbols `trim', `concat', `peek' and
 175 ;;; `split'.  If it is `trim' (the default), the trailing newline is
 176 ;;; removed and the string is returned.  If `concat', the string is
 177 ;;; returned with the trailing newline intact.  If `peek', the newline
 178 ;;; is left in the input port buffer and the string is returned.  If
 179 ;;; `split', the newline is split from the string and read-line
 180 ;;; returns a pair consisting of the truncated string and the newline.
 181
 182 (define* (read-line #:optional (port (current-input-port))
 183                     (handle-delim 'trim))
 184   (let* ((line/delim    (%read-line port))
 185          (line          (car line/delim))
 186          (delim         (cdr line/delim)))
 187     (case handle-delim
 188       ((trim) line)
 189       ((split) line/delim)
 190       ((concat) (if (and (string? line) (char? delim))
 191                     (string-append line (string delim))
 192                     line))
 193       ((peek) (if (char? delim)
 194                   (unread-char delim port))
 195               line)
 196       (else
 197        (error "unexpected handle-delim value: " handle-delim)))))