;;; 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 November 6, 1997
;; 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 3.2 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 3.2 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 3.2 Final' -- the final draft of revision 3.2 of the
;; HTML standard. The current document is written in English (EN).''
;; We shall ensure that this line appears at the beginning of each output
;; file.
;; Since all of the actual writing out of text and markup tags to files
;; will be accomplished by invoking output port procedures (that is,
;; procedures that take an output port as their only argument), it will be
;; 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, FIRST-LINE%,
;; 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 first-line%
(output% document-type-definition-specification #\newline))
;; Everything after this initial line in a World Wide Web document 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% first-line%
(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 list in which the
;; first element is the book's title (as a string), the second element is
;; the name of the publisher (as a string), the third element is the place
;; of publication (as a string), and the fourth element is the year of
;; publication (as an exact integer).
(define facts-of-publication
'(("Sagan, Carl"
("Cosmos" "Ballantine Books" "New York" 1980)
("Pale Blue Dot" "Ballantine Books" "New York" 1994)
("The Demon-Haunted World" "Random House" "New York" 1995))
("Hofstadter, Douglas R."
("Goedel, Escher, Bach: an Eternal Golden Braid"
"Basic Books, Inc., Publishers" "New York" 1979))
("Commoner, Barry"
("Making Peace with the Planet" "The New Press" "New York" 1992))
("Smullyan, Raymond"
("This Book Needs No Title" "Prentice-Hall, Inc"
"Englewood Cliffs, New Jersey" 1980)
("5000 B.C." "St. Martin's Press" "New York" 1983))
("Gould, Stephen Jay"
("Hen's Teeth and Horse's Toes" "W. W. Norton and Company"
"New York" 1983)
("Wonderful Life" "W. W. Norton and Company" "New York" 1989)
("The Mismeasure of Man" "W. W. Norton and Company" "New York" 1996)
("Questioning the Millennium" "Harmony Books" "New York" 1997))
("Gardner, Martin"
("The Night Is Large" "St. Martin's Press" "New York" 1996)
("The Flight of Peter Fromm" "William Kaufmann, Inc."
"Los Altos, California" 1973))))
;; The FACTS% procedure takes as its argument a four-element list giving a
;; book's facts of publication 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 a four-element list.
(if (not (and (list? book)
(= 4 (length book))))
(error 'facts% "The argument must be a four-element list"))
;; Break out the elements and give them names.
(let ((title (car book))
(publisher (cadr book))
(place-of-publication (caddr book))
(year-of-publication (cadddr book)))
;; Check that each element has the right type.
(if (not (string? title))
(error 'facts% "The title of the book must be a string"))
(if (not (string? publisher))
(error 'facts%
"The publisher of the book must be given as a string"))
(if (not (string? place-of-publication))
(error 'facts%
"The book's place of publication must be given as a string"))
(if (not (and (integer? year-of-publication)
(exact? year-of-publication)))
(error 'facts%
"The book's year of publication must be an exact integer"))
;; 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% title))
(output% #\. #\space
place-of-publication #\: #\space
publisher #\, #\space
year-of-publication #\.)))))
;; The BOOK-ROSTER% procedure takes as its argument a list of books (each
;; represented as a four-element list) 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,
;; and each entry is enclosed by ... tags, 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. 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)