;;; book-pages.ss: drafting Web pages containing bibliographical data
;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@math.grin.edu
;;; created November 5, 1997
;;; last revised May 4, 1998
;; This program takes the facts of publication (author, title, publisher,
;; date of publication, and place of publication) about various books and
;; writes them out to one or more files that can be displayed by Netscape,
;; Internet Explorer, and other browsers as documents on the World Wide
;; Web. To achieve this, the program also writes ``markup tags'' into the
;; files -- short character sequences that tell browsers how the rest of
;; the text is supposed to be displayed. (The browser usually does not
;; display the markup tags along with the rest of the text; when it
;; recognizes the tags as instructions to itself, it filters them out of
;; the document before displaying it.) The effect of each markup tag is
;; specified by the Hypertext Markup Language (HTML), a standard set of
;; conventions that all World Wide Web browsers observe and understand.
;; Actually, several revisions of the Hypertext Markup Language standard
;; have appeared, as the set of conventions has gradually increased in size
;; and complexity to reflect the increasing variety of treatments of text
;; that the creators of World Wide Web documents have insisted on. The
;; documents produced by this program conform to version 4.0 of the
;; standard.
;; Some browsers require that a World Wide Web document begin with an
;; announcement of what version of the HTML standard it conforms to and
;; what language it is written in. The conventional way to announce a
;; version 4.0 document written in English is to place the following string
;; at the beginning of the document:
(define document-type-definition-specification
"")
;; In other words: ``This is a document containing Hypertext Markup
;; Language tags, using no additional private or proprietary conventions.
;; The intended meanings of the markup tags are specified in a Document
;; Type Definition (DTD) prepared by the World Wide Web Consortium (W3C)
;; and entitled `HTML 4.0' -- revision 4.0 of the HTML standard. The
;; current document is written in English (EN). See the document
;; http://www.w3.org/TR/REC-html40/strict.dtd, a section of the World Wide
;; Web Consortium's Technical Report defining HTML 4.0, for the specifics
;; of that Document Type Definition.''
;; We shall ensure that this string appears at the beginning of each output
;; file.
;; This program performs all of the actual writing out of text and markup
;; tags to files by invoking output port procedures (that is, procedures
;; that take an output port as their only argument). It is therefore
;; helpful to have some utilities for creating and operating on such
;; procedures. In this program, we adopt (for readability) the convention
;; that the name of every output port procedure and of every procedure that
;; creates output port procedures ends with the character %.
;; Here, for instance, is a procedure that takes any number of Scheme
;; values as arguments and returns an output port procedure that, when
;; invoked, calls the Scheme DISPLAY procedure to write out all those
;; values. It's called OUTPUT%:
(define output%
(lambda arguments
(lambda (port)
;; Make sure PORT is an output port.
(if (not (output-port? port))
(error 'output% "Output must be sent to an output port"))
;; Display each argument through that port.
(for-each (lambda (value)
(display value port))
arguments))))
;; So, for instance, when the following output port procedure, DTD%,
;; is invoked, it writes the DOCUMENT-TYPE-DEFINITION-SPECIFICATION string
;; on a line by itself through the port that it receives as its argument
;; and into a file.
(define dtd%
(output% document-type-definition-specification #\newline))
;; Everything in a World Wide Web document after the DTD specification is
;; supposed to be enclosed between a matched pair of markup tags: at
;; the beginning, at the end. Many HTML tags come in similar
;; matched pairs, surrounding the text to which some kind of special
;; treatment is to be given. We shall ensure that appears as the
;; second line of each of the output files, and as the last line.
;; One approach to creating the matched pair would be to write a procedure
;; ENCLOSE-IN-HTML-TAGS% that takes as its argument an output port
;; procedure that writes out the text to be enclosed, and returns an output
;; port procedure that writes out the initial tag, then the enclosed text,
;; then the final tag:
;; (define enclose-in-html-tags%
;; (lambda (text%)
;; (lambda (port)
;; ((output% "" #\newline) port)
;; (text% port)
;; ((output% "" #\newline) port)))))
;; However, this idea can be usefully generalized in two ways. First, we
;; will often wish to write an output port procedure that, like this one,
;; consists entirely of a succession of calls to other output port
;; procedures, with the same port argument for each one. This control
;; structure is common enough to deserve a name and a definition; we'll
;; call it a ``chain'' of calls, and provide a definition of a CHAIN%
;; procedure that takes any number of output port procedures as arguments
;; and returns an output port procedure that simply calls each of those
;; output port procedures in turn:
(define chain%
(lambda procedures
(lambda (port)
;; Make sure PORT is an output port.
(if (not (output-port? port))
(error 'chain% "Output must be sent to an output port"))
;; Apply each of the output port procedures to that port.
(for-each (lambda (procedure%)
(procedure% port))
procedures))))
;; So, for example, we could now write the definition of
;; ENCLOSE-IN-HTML-TAGS% like this:
;; (define enclose-in-html-tags%
;; (lambda (text%)
;; (chain% (output% "" #\newline)
;; text%
;; (output% "" #\newline))))
;; The second generalization is prompted by the fact that the matched pair
;; and is only one of many such pairs in HTML -- for
;; instance, one also writes and
to enclose a paragraph of text,
;; to enclose an unnumbered list, and so on. So it will be
;; helpful to have a general-purpose enclosing procedure that takes as one
;; of its arguments the string of letters that indicates which particular
;; tag-pair is to be used for enclosing the text:
(define enclose%
(lambda (tag-string text%)
;; Make sure that TAG-STRING is a string and TEXT% is a procedure.
(if (not (string? tag-string))
(error 'enclose% "The first argument must be a string"))
(if (not (procedure? text%))
(error 'enclose%
"The second argument must be an output port procedure"))
;; Chain together the opening tag, the enclosed text, and the closing
;; tag.
(chain% (output% #\< tag-string #\> #\newline)
text%
(output% #\< #\/ tag-string #\> #\newline))))
;; The tags inserted by ENCLOSE% are placed on separate lines, before and
;; after the enclosed text. We also sometimes use matched pairs of markup
;; tags placed immediately next to the enclosed text. For instance, to ask
;; the browser to emphasize a particular word, we can put the tag just
;; before the word and its mate just after it, thus:
;; Emphasize this word.
;; So it will also be helpful to have a variant of ENCLOSE% that does not
;; insert newlines:
(define enclose-on-same-line%
(lambda (tag-string text%)
;; Make sure that TAG-STRING is a string and TEXT% is a procedure.
(if (not (string? tag-string))
(error 'enclose-on-same-line%
"The first argument must be a string"))
(if (not (procedure? text%))
(error 'enclose-on-same-line%
"The second argument must be an output port procedure"))
;; Chain together the opening tag, the enclosed text, and the closing
;; tag.
(chain% (output% #\< tag-string #\>)
text%
(output% #\< #\/ tag-string #\>))))
;; Between the and tags in a World Wide Web document, one is
;; supposed to provide (1) a header and (2) a body.
;; The header contains the document's title and may also contain other
;; information that can be used by automatic indexing and cross-referencing
;; programs; we'll stick with just the title. The header section begins
;; with the tag and ends with its mate, and the title that is
;; given between these tags is similarly enclosed between the tags
;; and . A typical header therefore looks like this:
;;
;; CSC 151: Fundamentals of computer science I
;;
;; The following procedure, HEADER%, takes a string argument that gives the
;; desired document title and returns an output port procedure that writes
;; the entire header through a port:
(define header%
(lambda (title-string)
;; Make sure that the argument is a string.
(if (not (string? title-string))
(error 'header% "The title must be given as a string"))
;; Enclose the title in ... tags, add a newline after
;; the enclose title, and enclose the result between and
;; .
(enclose% "head"
(chain% (enclose-on-same-line% "title"
(output% title-string))
(output% #\newline)))))
;; The body that follows the header is supposed to begin with the tag
;; and end with the matching tag . What lies between these
;; tags is what the browser actually displays in the window.
;; Here, then, is the overall outline of a World Wide Web document
;; generator:
(define WWW-document%
(lambda (title-string displayed-text%)
;; Make sure that the title string is indeed a string and that
;; DISPLAYED-TEXT% is a procedure.
(if (not (string? title-string))
(error 'WWW-document% "The first argument must be a string"))
(if (not (procedure? displayed-text%))
(error 'WWW-document%
"The second argument must be an output port procedure"))
;; Enclose the displayed text in ... tags, chain the
;; header to the front of it, enclose the result in ..
;; tags, and chain the document type definition specification at the
;; very beginning.
(chain% dtd%
(enclose% "html" (chain% (header% title-string)
(enclose% "body" displayed-text%))))))
;; Now let's consider how to come up with the title string and the output
;; port procedure that writes out the displayed text, given the
;; bibliographical database. The database is given in the form of an
;; association list in which each key is the name of an author (as a
;; string) and the associated value is a list of one or more books written
;; by that author. Each book is itself represented as a record with four
;; fields, none of them mutable: The first field is the book's title (as a
;; string), the second is the name of the publisher (as a string), the
;; third is the place of publication (as a string), and the fourth is the
;; year of publication (as an exact integer).
;; Here are the definitions relating to this record type, as constructed
;; by the GENERATE-RECORD-DEFINITION-FILE procedure that we studied in the
;; lab on metaprogramming. I've edited out the mutators.
(define make-book
(lambda (title
publisher
place-of-publication
year-of-publication)
(vector
'book
title
publisher
place-of-publication
year-of-publication)))
(define book?
(lambda (obj)
(and (vector? obj)
(= (vector-length obj) 5)
(eq? (vector-ref obj 0) 'book))))
(define book-title
(lambda (b)
(if (not (book? b))
(error 'book-title "The argument must be of type BOOK"))
(vector-ref b 1)))
(define book-publisher
(lambda (b)
(if (not (book? b))
(error 'book-publisher "The argument must be of type BOOK"))
(vector-ref b 2)))
(define book-place-of-publication
(lambda (b)
(if (not (book? b))
(error 'book-place-of-publication
"The argument must be of type BOOK"))
(vector-ref b 3)))
(define book-year-of-publication
(lambda (b)
(if (not (book? b))
(error 'book-year-of-publication
"The argument must be of type BOOK"))
(vector-ref b 4)))
;; Now here is the database:
(define facts-of-publication
`(("Sagan, Carl"
,(make-book "Cosmos" "Ballantine Books" "New York" 1980)
,(make-book "Pale Blue Dot" "Ballantine Books" "New York" 1994)
,(make-book "The Demon-Haunted World" "Random House" "New York" 1995))
("Hofstadter, Douglas R."
,(make-book "Goedel, Escher, Bach: an Eternal Golden Braid"
"Basic Books, Inc., Publishers" "New York" 1979))
("Commoner, Barry"
,(make-book "Making Peace with the Planet" "The New Press" "New York"
1992))
("Smullyan, Raymond"
,(make-book "This Book Needs No Title" "Prentice-Hall, Inc"
"Englewood Cliffs, New Jersey" 1980)
,(make-book "5000 B.C." "St. Martin's Press" "New York" 1983))
("Gould, Stephen Jay"
,(make-book "Hen's Teeth and Horse's Toes" "W. W. Norton and Company"
"New York" 1983)
,(make-book "Wonderful Life" "W. W. Norton and Company" "New York"
1989)
,(make-book "The Mismeasure of Man" "W. W. Norton and Company"
"New York" 1996)
,(make-book "Questioning the Millennium" "Harmony Books" "New York"
1997))
("Gardner, Martin"
,(make-book "The Night Is Large" "St. Martin's Press" "New York" 1996)
,(make-book "The Flight of Peter Fromm" "William Kaufmann, Inc."
"Los Altos, California" 1973))))
;; The FACTS% procedure takes a book as its argument and returns an output
;; port procedure that writes out a bibliography entry for that book, in a
;; standard format.
(define facts%
(lambda (book)
;; Check that BOOK is indeed a book.
(if (not (book? book))
(error 'facts% "The argument must be a book"))
;; Put the title in italics by enclosing it in ... tags.
;; Chain the result with the other data. The specific format of
;; the eventual output will be:
;;
;; The title. Place: Publisher and Sons, Inc., 1999.
(chain% (enclose-on-same-line% "i" (output% (book-title book)))
(output% #\. #\space
(book-place-of-publication book) #\: #\space
(book-publisher book) #\, #\space
(book-year-of-publication book) #\.))))
;; The BOOK-ROSTER% procedure takes as its argument a list of books and
;; returns an output port procedrue that writes out an unnumbered sequence
;; of bibliography entries, one for each book. The unnumbered sequence is
;; enclosed by tags (``unordered list''), and each entry is
;; enclosed by ... tags (``list item''), as specified in the
;; HTML standard.
(define book-roster%
(lambda (book-list)
;; Make sure BOOK-LIST is a list.
(if (not (list? book-list))
(error 'book-roster% "The argument must be a list"))
;; Enclose each bibliography entry in ... tags to make it a
;; ``list item.'' Chain the result to a newline. Do this for every
;; book on the list and chain the results together. Finally, enclose
;; the entire chain in tags to make an unnumbered
;; sequence out of it
(enclose% "ul"
(apply chain%
(map (lambda (book)
(chain% (enclose-on-same-line% "li"
(facts% book))
(output% #\newline)))
book-list)))))
;; Each element of the FACTS-OF-PUBLICATION list is a pair that has as its
;; car the name of an author and as its cdr a list of that author's books.
;; The EXHIBIT% procedure takes such a pair as its argument and returns an
;; output port procedure suitable for use as the DISPLAYED-TEXT% argument
;; to the WWW-DOCUMENT% procedure above: The displayed text consists a
;; large header, giving the author's name, followed by a sequence of
;; bibliography entries, as constructed by BOOK-ROSTER%.
(define exhibit%
(lambda (pair)
;; Check that PAIR is indeed a pair.
(if (not (pair? pair))
(error 'exhibit% "The argument must be a pair"))
;; Separate the author from the books.
(let ((author (car pair))
(books (cdr pair)))
;; Put the author's name in a primary header by enclosing it in
;; ...
tags (``header, size 1'' -- the largest size). Leave a
;; blank line after the header, then chain in the unnumbered sequence
;; of bibliography entries returned by BOOK-ROSTER%.
(chain% (enclose-on-same-line% "h1" (output% author))
(output% #\newline #\newline)
(book-roster% books)))))
;; The SURNAME procedure takes as argument a person's name, as a string in
;; the format "Lastname, Firstname(s)", and returns the part of the string
;; that occurs before the comma. (If the string contains two or more
;; commas, the surname is assumed to be the part up to the leftmost comma;
;; if the string contains no commas, the surname is assumed to be the
;; entire string.
(define surname
(lambda (full-name)
;; Check that FULL-NAME is a string.
(if (not (string? full-name))
(error 'surname "The argument must be a string"))
;; Search FULL-NAME from left to right, looking for a comma.
(let ((len (string-length full-name)))
(let loop ((position 0))
(cond
;; If the end of the string is reached, return the whole thing.
((= position len) full-name)
;; If a comma is encountered, return the part of the string that
;; has so far been traversed.
((char=? #\, (string-ref full-name position))
(substring full-name 0 position))
;; Otherwise, keep searching.
(else (loop (+ position 1))))))))
;; The BUILD-DOCUMENT procedure takes one author-and-books element from the
;; bibliographical database and creates a World Wide Web document for that
;; author in the current working directory. The name of the file will be
;; the surname of the author followed by the suffix .html (which is typical
;; for HTML documents) -- for example, the World Wide Web document listing
;; the Carl Sagan books will be in the file Sagan.html.
(define build-document
(lambda (pair)
;; Check that PAIR is indeed a pair.
(if (not (pair? pair))
(error 'build-document "The argument must be a pair"))
;; Recover the author's surname and use it to construct the name of the
;; output file.
(let* ((author (car pair))
(file-name (string-append (surname author) ".html")))
;; Obtain an output port procedure that will push the entire document
;; through a port and use CALL-WITH-OUTPUT-FILE to invoke that
;; procedure.
(call-with-output-file file-name
(WWW-document% author (exhibit% pair))))))
;; Here's the main program -- the command that sets all the others in
;; motion:
;; To produce the complete set of World Wide Web documents, one for each
;; author, we apply the BUILD-DOCUMENT procedure to each element of the
;; bibliographical database.
(for-each build-document facts-of-publication)
;; When all the documents have been built, shut down Scheme.
(exit)