101 lines
3.5 KiB
Scheme
101 lines
3.5 KiB
Scheme
|
;;; 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)))
|