home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / runtime / input.scm < prev    next >
Text File  |  1999-12-21  |  4KB  |  143 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: input.scm,v 14.20 1999/12/21 19:05:13 cph Exp $
  4.  
  5. Copyright (c) 1988-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; Input
  23. ;;; package: (runtime input-port)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. ;;;; Input Ports
  28.  
  29. (define (input-port/char-ready? port interval)
  30.   ((input-port/operation/char-ready? port) port interval))
  31.  
  32. (define (input-port/peek-char port)
  33.   ((input-port/operation/peek-char port) port))
  34.  
  35. (define (input-port/read-char port)
  36.   ((input-port/operation/read-char port) port))
  37.  
  38. (define (input-port/discard-char port)
  39.   ((input-port/operation/discard-char port) port))
  40.  
  41. (define (input-port/read-string port delimiters)
  42.   ((input-port/operation/read-string port) port delimiters))
  43.  
  44. (define (input-port/discard-chars port delimiters)
  45.   ((input-port/operation/discard-chars port) port delimiters))
  46.  
  47. (define (input-port/read-substring! port string start end)
  48.   ((input-port/operation/read-substring port) port string start end))
  49.  
  50. (define (input-port/read-string! port string)
  51.   (input-port/read-substring! port string 0 (string-length string)))
  52.  
  53. (define (input-port/read-line port)
  54.   (let ((line (input-port/read-string port char-set:newline)))
  55.     ;; Discard delimiter, if any -- this is a no-op at EOF.
  56.     (input-port/discard-char port)
  57.     line))
  58.  
  59. (define eof-object
  60.   "EOF Object")
  61.  
  62. (define (eof-object? object)
  63.   (eq? object eof-object))
  64.  
  65. (define (make-eof-object port)
  66.   port
  67.   eof-object)
  68.  
  69. ;;;; Input Procedures
  70.  
  71. (define (char-ready? #!optional port interval)
  72.   (input-port/char-ready? (if (default-object? port)
  73.                   (current-input-port)
  74.                   (guarantee-input-port port))
  75.               (if (default-object? interval)
  76.                   0
  77.                   (begin
  78.                 (if (not (exact-nonnegative-integer? interval))
  79.                     (error:wrong-type-argument interval
  80.                                    false
  81.                                    'CHAR-READY?))
  82.                 interval))))
  83.  
  84. (define (peek-char #!optional port)
  85.   (let ((port
  86.      (if (default-object? port)
  87.          (current-input-port)
  88.          (guarantee-input-port port))))
  89.     (let loop ()
  90.       (or (input-port/peek-char port)
  91.       (loop)))))
  92.  
  93. (define (read-char #!optional port)
  94.   (let ((port
  95.      (if (default-object? port)
  96.          (current-input-port)
  97.          (guarantee-input-port port))))
  98.     (let loop ()
  99.       (or (input-port/read-char port)
  100.       (loop)))))
  101.  
  102. (define (read-char-no-hang #!optional port)
  103.   (let ((port
  104.      (if (default-object? port)
  105.          (current-input-port)
  106.          (guarantee-input-port port))))
  107.     (if (input-port/char-ready? port 0)
  108.     (input-port/read-char port)
  109.     (let ((eof? (port/operation port 'EOF?)))
  110.       (and eof?
  111.            (eof? port)
  112.            eof-object)))))
  113.  
  114. (define (read-string delimiters #!optional port)
  115.   (input-port/read-string (if (default-object? port)
  116.                   (current-input-port)
  117.                   (guarantee-input-port port))
  118.               delimiters))
  119.  
  120. (define (read #!optional port parser-table)
  121.   (parse-object (if (default-object? port)
  122.             (current-input-port)
  123.             (guarantee-input-port port))
  124.         (if (default-object? parser-table)
  125.             (current-parser-table)
  126.             parser-table)))
  127.  
  128. (define (read-line #!optional port)
  129.   (input-port/read-line (if (default-object? port)
  130.                 (current-input-port)
  131.                 (guarantee-input-port port))))
  132.  
  133. (define (read-string! string #!optional port)
  134.   (input-port/read-string! (if (default-object? port)
  135.                    (current-input-port)
  136.                    (guarantee-input-port port))
  137.                string))
  138.  
  139. (define (read-substring! string start end #!optional port)
  140.   (input-port/read-substring! (if (default-object? port)
  141.                   (current-input-port)
  142.                   (guarantee-input-port port))
  143.                   string start end))