;;; 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)))