scsh-0.5/scsh/oldhere.scm

101 lines
3.5 KiB
Scheme
Raw Normal View History

1995-10-13 23:34:21 -04:00
;;; 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)))