;;; Here documents in Scheme for scsh scripts.
;;; These are like "here documents" for sh and csh shell scripts
;;; (i.e., the <<EOF redirection).
;;; Copyright (c) 1995 by Olin Shivers.

;;; #<EOF
;;; Hello, there.
;;; This is read by Scheme as a string,
;;; terminated by the first occurrence
;;; of newline-E-O-F.
;;; EOF

;;; Thus, 
;;;     #<foo
;;;     Hello, world.
;;;     foo
;;; is the same thing as
;;;     "Hello, world."

;;; These are useful for writing down long, constant strings -- such
;;; as long, multi-line FORMAT strings, or arguments to Unix programs, e.g.
;;; 	;; Free up some disk space for my netnews files.
;;; 	(run (csh -c #<EOF
;;; 	cd ~bdc
;;; 	rm -rf .
;;; 	echo All done.
;;;    
;;; 	EOF))

;;; The syntax is as follows: the three characters "#<" introduce the
;;; here-string. The characters between the second "<" and the next newline
;;; are the *delimiter word." *All* chars between the second "<" and the next
;;; newline comprise the delimiter word -- including any white space. The
;;; newline char separates the delimiter word from the body of the string. The
;;; string body is terminated by a newline followed by the delimiter string.
;;; Absolutely *no* interpretation is done on the input string, except for
;;; scanning for the terminating delimiter word. Control chars, white space,
;;; quotes, backslash chars -- everything is copied as-is.
;;; 
;;; If EOF is encountered before reading the end of the here string, an
;;; error is signalled.

(define (read-here-string port)
  ;; First, read in the delimiter.
  (let ((delim (read-line port)))
    (cond ((eof-object? delim)
	   (reading-error port "EOF while reading #< here-string delimiter."))
	  ((zero? (string-length delim))
	   (reading-error port "#< here-string empty delimiter"))

	  ;; This loop works as follows. We enter the loop after having
	  ;; read a newline. We scan into the text until we discover
	  ;; delimiter match/no-match. If match, we exit the loop;
	  ;; if no match, we read in the rest of the line and iterate. 
	  ;; TEXT is the text we've read so far -- a list of strings in 
	  ;; reverse order.
	  (else
	   (let lp ((text '()))
	     (cond ((delimiter-scan delim port) =>
		    (lambda (line-start)
		      (let ((text (cons line-start text))
			    (ls-len (string-length line-start)))
			(lp (if (char=? #\newline (string-ref line-start
							      (- ls-len 1)))
				text
				(let ((line-rest (read-line port 'concat)))
				  (if (eof-object? line-rest)
				      (reading-error port
				       "EOF while reading #< here-string.")
				      (cons line-rest text))))))))

		   ;; We're done. The last line, tho, needs its newline
		   ;; stripped off.
		   ((null? text) "")
		   (else (let* ((last-chunk (car text))
				(lc-len (string-length last-chunk))
				(last-chunk (substring last-chunk 0 (- lc-len 1)))
				(text (cons last-chunk (cdr text))))
			   (make-immutable! (apply string-append
						   (reverse text)))))))))))


;;; If the next chars read from PORT match DELIM, return false.
;;; Otherwise, return the string you read from PORT to determine the non-match.
;;; If EOF is encountered, report an error.

(define (delimiter-scan delim port)
  (let ((len (string-length delim)))
    (let lp ((i 0))
      (and (< i len)
	   (let ((c (read-char port)))
	     (cond  ((eof-object? c)
		     (reading-error port "EOF while reading #< here string."))
		    ((char=? c (string-ref delim i))
		     (lp (+ i 1)))
		    (else (string-append (substring delim 0 i)
					 (string c)))))))))

;(define-sharp-macro #\<
;  (lambda (c port) (read-here-string port)))