module/slib/lineio.scm

   1 ; "lineio.scm", line oriented input/output functions for Scheme.
   2 ; Copyright (c) 1992, 1993 Aubrey Jaffer
   3 ;
   4 ;Permission to copy this software, to redistribute it, and to use it
   5 ;for any purpose is granted, subject to the following restrictions and
   6 ;understandings.
   7 ;
   8 ;1.  Any copy made of this software must include this copyright notice
   9 ;in full.
  10 ;
  11 ;2.  I have made no warrantee or representation that the operation of
  12 ;this software will be error-free, and I am under no obligation to
  13 ;provide any services, by way of maintenance, update, or otherwise.
  14 ;
  15 ;3.  In conjunction with products arising from the use of this
  16 ;material, there shall be no use of my name in any advertising,
  17 ;promotional, or sales literature without prior written consent in
  18 ;each case.
  19
  20
  21 ;;@args
  22 ;;@args port
  23 ;;Returns a string of the characters up to, but not including a
  24 ;;newline or end of file, updating @var{port} to point to the
  25 ;;character following the newline.  If no characters are available, an
  26 ;;end of file object is returned.  The @var{port} argument may be
  27 ;;omitted, in which case it defaults to the value returned by
  28 ;;@code{current-input-port}.
  29 (define (read-line . port)
  30   (let* ((char (apply read-char port)))
  31     (if (eof-object? char)
  32         char
  33         (do ((char char (apply read-char port))
  34              (clist '() (cons char clist)))
  35             ((or (eof-object? char) (char=? #\newline char))
  36              (list->string (reverse clist)))))))
  37
  38 ;;@args string
  39 ;;@args string port
  40 ;;Fills @1 with characters up to, but not including a newline or end
  41 ;;of file, updating the @var{port} to point to the last character read
  42 ;;or following the newline if it was read.  If no characters are
  43 ;;available, an end of file object is returned.  If a newline or end
  44 ;;of file was found, the number of characters read is returned.
  45 ;;Otherwise, @code{#f} is returned.  The @var{port} argument may be
  46 ;;omitted, in which case it defaults to the value returned by
  47 ;;@code{current-input-port}.
  48 (define (read-line! str . port)
  49   (let* ((char (apply read-char port))
  50          (midx (+ -1 (string-length str))))
  51     (if (eof-object? char)
  52         char
  53         (do ((char char (apply read-char port))
  54              (i 0 (+ 1 i)))
  55             ((or (eof-object? char)
  56                  (char=? #\newline char)
  57                  (> i midx))
  58              (if (> i midx) #f i))
  59           (string-set! str i char)))))
  60
  61 ;;@args string
  62 ;;@args string port
  63 ;;Writes @1 followed by a newline to the given @var{port} and returns
  64 ;;an unspecified value.  The @var{Port} argument may be omitted, in
  65 ;;which case it defaults to the value returned by
  66 ;;@code{current-input-port}.@refill
  67 (define (write-line str . port)
  68   (apply display str port)
  69   (apply newline port))
  70
  71 ;;@args path
  72 ;;@args path port
  73 ;;Displays the contents of the file named by @1 to @var{port}.  The
  74 ;;@var{port} argument may be ommited, in which case it defaults to the
  75 ;;value returned by @code{current-output-port}.
  76 (define (display-file path . port)
  77   (set! port (if (null? port) (current-output-port) (car port)))
  78   (call-with-input-file path
  79     (lambda (inport)
  80       (do ((line (read-line inport) (read-line inport)))
  81           ((eof-object? line))
  82         (write-line line port)))))