scsh-0.5/scsh/here.scm

120 lines
4.4 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. See file COPYING.
;;; There are two kinds of here string, both introduced by the #< read macro.
;;;
;;; Character-delimited here strings:
;;; A *character-delimited* here string has the form
;;; #<x...stuff...x
;;; where x is any single character (except <, see below), which is used
;;; to delimit the string bounds.
;;; Here are some examples:
;;;
;;; Here string syntax Ordinary syntax
;;; ------------------ ---------------
;;; #<|Hello, world.| "Hello, world."
;;; #<!"Ouch," he said.! "\"Ouch,\" he said."
;;;
;;; There is *no* interpretation of characters within the here string;
;;; characters are all copied verbatim.
;;;
;;; Line-delimited here strings:
;;; If the macro begins "#<<" then it introduces a *line-delimited* here
;;; string. These are similar to the "here documents" of sh and
;;; csh. Line-delimited here strings are delimited by the line of text coming
;;; after the "#<<" sequence. For example:
;;;
;;; #<FOO
;;; Hello, there.
;;; This is read by Scheme as a string,
;;; terminated by the first occurrence
;;; of newline-F-O-O-newline or newline-F-O-O-eof.
;;; FOO
;;;
;;; 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 /urops
;;; rm -rf *
;;; echo All done.
;;;
;;; EOF
;;; ))
;;;
;;; The advantage they have over the double-quote syntax -- "Hello, world." --
;;; is that there is no need to backslash-quote special characters internal
;;; to the string, such as the double-quote or backslash characters.
;;; Line-delimited here-string syntax:
;;; The characters "#<<" introduce the here-string. The characters
;;; between the "#<<" and the next newline are the *delimiter line*. *All* chars
;;; between the "#<<" and the next newline comprise the delimiter line --
;;; including any white space. The newline char separates the delimiter line
;;; from the body of the string. The string body is terminated by a line of
;;; text which exactly matches the delimiter line. This terminating line can
;;; be ended by either a newline or end-of-file. Absolutely *no*
;;; interpretation is done on the input string. Control chars, white space,
;;; quotes, backslash chars -- everything is copied as-is. The newline
;;; immediately preceding the terminating delimiter line is *not* included in
;;; the result string (leave an extra blank line if you need to put a final
;;; newline in the here string -- see the example above). If EOF is
;;; encountered before reading the end of the here string, an error is
;;; signalled.
(define (read-here-string port)
(make-immutable!
(let ((delim-char (read-char port)))
(cond ((eof-object? delim-char)
(reading-error port "EOF while reading #< here-string delimiter."))
((char=? delim-char #\<) ; It's a #<<EOF long here-string.
(read-line-delimited-here-string port))
;; It's short: #<|Here's the string.|
(else (receive (str terminator)
(read-delimited (char-set delim-char) port 'split)
(if (eof-object? terminator)
(reading-error port "EOF while reading #< here-string.")
str)))))))
(define (read-line-delimited-here-string port)
;; First, read in the delimiter line.
(let ((delim (read-line port)))
(cond ((eof-object? delim)
(reading-error port
"EOF while reading #<< here-string delimiter line."))
((= 1 (string-length delim))
(reading-error port "#<< here-string empty delimiter line"))
(else
(let lp ((text '()))
(receive (line terminator) (read-line port 'split)
(cond ((equal? line delim)
;; We're done. The last newline must be stripped
;; off (with the CDR application).
(if (pair? text)
(apply string-append (reverse (cdr text)))
""))
((eof-object? terminator)
(reading-error port "EOF while reading #<< here-string."))
(else (lp `(,(string terminator) ,line . ,text))))))))))
(define-sharp-macro #\<
(lambda (c port)
(read-char port) ; Snarf the first < char.
(read-here-string port)))