(yreq "Utilities/yenta-utils")

;;;; Input routines for reading without blocking the scheduler.

;;; Reads a fully formed scheme expression from any port; if #f is given as
;;; the port, the standard input is used.  Expressions to be read may not
;;; include #'s except in booleans (this saves us from the security hole of
;;; allow the #. reader macro through).
(define (sch-read-exp port use)
  (let ((exp (sr:make-string 1000))
	(parens 0)
	(quotes #f)
	(done #f)
	(is-list #f)
	(something #f)
	(read-test? (cond ((tcp:tcp? port)
			   (lambda () (> (tcp:chars-unread port) 0)))
			  ((ssl? port)
			   (lambda () (> (ssl:pending port) 0)))
			  (port
			   (lambda () (char-ready? port)))
			  (else
			   char-ready?)))
	(do-read (if port
		     (lambda () (read-char port))
		     read-char))
	(prev-char #f))
    (scheduler:simple-do
	(done (use (call-with-input-string (sr:to-string exp) read))) ; Safe 'cause we only allow #\t or #\f 
      (scheduler:when (read-test?)	; Make sure there's a char there to begin with.
        (do () ((or done (not (read-test?)))) ; Now loop without yielding until there aren't.  [ %%% Vulnerable to a force-feeding attack...]
	  (let ((char (do-read)))
	    (cond ((or (eof-object? char)
		       (and (eq? #\# prev-char)
			    (not quotes)
			    (not (eq? char #\f)) ; %%% Errr...  I guess #F and #T aren't booleans, but #f and #t are?  Should use char-ci=?, I think.
			    (not (eq? char #\t))))
		   (set! exp (sr:make-string 1000))
		   (set! done #t))
		  (t
		   (sr:add-char! char exp)))
	    (cond ((and quotes (eq? prev-char #\\))
		   (set! prev-char #\nul)) ; %%% Why #\nul and not just #f?
		  (t
		   (set! prev-char char)
		   (unless (eof-or-char-whitespace? char)
		     (set! something #t))
		   (case char
		     ((#\nl) (when (and (>= 0 parens) (not quotes) something)
			       (set! done #t)))
		     ((#\() (unless quotes
			      (inc! parens))
			    (set! is-list #t))
		     ((#\)) (unless quotes
			      (dec! parens))
			    (when (and (>= 0 parens) is-list)
			      (set! done #t)))
		     ((#\") (set! quotes (not quotes))
			    (when (and (not quotes)
				       (not is-list))
			      (set! done #t))))))))))))

;;;; Reading just strings or lines, not true s-expressions.

(define (sch-read-char con use)
  (scheduler:when (> (tcp:chars-unread con) 0)
		  (use (read-char con))))

(define (sch-peek-char con use)
  (scheduler:when (> (tcp:chars-unread con) 0)
		  (use (peek-char con))))

;;; Reads a string, terminated with whitespace, from a TCP connection.
;;; Reads and throws away initial whitespace.
(define (sch-read-string con use)
  (define ret (sr:make-string 1000))
  (scheduler:sequences
   ((scheduler:do-with ((char (sch-peek-char con) 
			      (sch-peek-char con)))
       ((eof-or-char-not-whitespace? char) 'done)
      (scheduler:call (sch-read-char con))))
   ((scheduler:do-with ((char (sch-peek-char con)
			      (sch-peek-char con)))
       ((eof-or-char-whitespace? char)
	(use (sr:to-string ret)))
      (sr:add-char! char ret)
      (scheduler:call (sch-read-char con))))))

;;; Reads a line from a TCP connection; the line should end with a CRLF.
;;; (Actually, the line can end with CR or LF, followed by any character.
;;;  But CRLF is what's expected.)
(define (sch-read-line con use)
  (define (line-terminator? char)
    (cond ((eq? char #\cr))
	  ((eq? char #\nl))
	  (else #f)))
  (define ret (sr:make-string 1000))
  (scheduler:do-with ((char (sch-peek-char con)
			    (sch-peek-char con)))
     ((or (eof-object? char) (line-terminator? char))
      (scheduler:sequences
       ((scheduler:call (sch-read-char con)))
       ((scheduler:call (sch-read-char con)))
       ((use (sr:to-string ret)))))
     (sr:add-char! char ret)
     (scheduler:call (sch-read-char con))))

;;; End of file.
