buffered-input.scm 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113
  1. ;;;; buffered-input.scm --- construct a port from a buffered input reader
  2. ;;;;
  3. ;;;; Copyright (C) 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. (define-module (ice-9 buffered-input)
  19. #:export (make-buffered-input-port
  20. make-line-buffered-input-port
  21. set-buffered-input-continuation?!))
  22. ;; @code{buffered-input-continuation?} is a property of the ports
  23. ;; created by @code{make-line-buffered-input-port} that stores the
  24. ;; read continuation flag for each such port.
  25. (define buffered-input-continuation? (make-object-property))
  26. (define (set-buffered-input-continuation?! port val)
  27. "Set the read continuation flag for @var{port} to @var{val}.
  28. See @code{make-buffered-input-port} for the meaning and use of this
  29. flag."
  30. (set! (buffered-input-continuation? port) val))
  31. (define (make-buffered-input-port reader)
  32. "Construct a line-buffered input port from the specified @var{reader}.
  33. @var{reader} should be a procedure of one argument that somehow reads
  34. a chunk of input and returns it as a string.
  35. The port created by @code{make-buffered-input-port} does @emph{not}
  36. interpolate any additional characters between the strings returned by
  37. @var{reader}.
  38. @var{reader} should take a boolean @var{continuation?} argument.
  39. @var{continuation?} indicates whether @var{reader} is being called to
  40. start a logically new read operation (in which case
  41. @var{continuation?} is @code{#f}) or to continue a read operation for
  42. which some input has already been read (in which case
  43. @var{continuation?} is @code{#t}). Some @var{reader} implementations
  44. use the @var{continuation?} argument to determine what prompt to
  45. display to the user.
  46. The new/continuation distinction is largely an application-level
  47. concept: @code{set-buffered-input-continuation?!} allows an
  48. application to specify when a read operation is considered to be new.
  49. But note that if there is non-whitespace data already buffered in the
  50. port when a new read operation starts, this data will be read before
  51. the first call to @var{reader}, and so @var{reader} will be called
  52. with @var{continuation?} set to @code{#t}."
  53. (let ((read-string "")
  54. (string-index -1))
  55. (letrec ((get-character
  56. (lambda ()
  57. (cond
  58. ((eof-object? read-string)
  59. read-string)
  60. ((>= string-index (string-length read-string))
  61. (set! string-index -1)
  62. (get-character))
  63. ((= string-index -1)
  64. (set! read-string (reader (buffered-input-continuation? port)))
  65. (set! string-index 0)
  66. (if (not (eof-object? read-string))
  67. (get-character)
  68. read-string))
  69. (else
  70. (let ((res (string-ref read-string string-index)))
  71. (set! string-index (+ 1 string-index))
  72. (if (not (char-whitespace? res))
  73. (set! (buffered-input-continuation? port) #t))
  74. res)))))
  75. (input-waiting
  76. (lambda ()
  77. (if (eof-object? read-string)
  78. 1
  79. (- (string-length read-string) string-index))))
  80. (port #f))
  81. (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r"))
  82. (set! (buffered-input-continuation? port) #f)
  83. port)))
  84. (define (make-line-buffered-input-port reader)
  85. "Construct a line-buffered input port from the specified @var{reader}.
  86. @var{reader} should be a procedure of one argument that somehow reads
  87. a line of input and returns it as a string @emph{without} the
  88. terminating newline character.
  89. The port created by @code{make-line-buffered-input-port} automatically
  90. interpolates a newline character after each string returned by
  91. @var{reader}.
  92. @var{reader} should take a boolean @var{continuation?} argument. For
  93. the meaning and use of this argument, see
  94. @code{make-buffered-input-port}."
  95. (make-buffered-input-port (lambda (continuation?)
  96. (let ((str (reader continuation?)))
  97. (if (eof-object? str)
  98. str
  99. (string-append str "\n"))))))
  100. ;;; buffered-input.scm ends here