;; The PLT Scheme code for building the DoCS web site.
;; Path information for relevant journal directories.
;; These definitions have to be changed if the journal
;; is moved or if any of the directories are renamed.
(define journal-directory-absolute "~/email/book/journal/")
(define journal-code-directory-relative "programs/")
(define journal-entries-directory-relative "entries/")
(define journal-supplements-directory-relative "supplements/")
;; Given the above, the directory structure looks as follows:
;;
;; ~/email/book/journal/programs/builder.scm (this file)
;; builder.htm (generated)
;; supplements/bib.txt (created by hand)
;; bib.htm (generated)
;; index.htm (generated)
;; entries/yy/mm/dd/day.txt (created by hand)
;; day.htm (generated)
;;
;; where the "generated" files are built by the code in this file.
;; The next two functions generate the attribute strings that determine,
;; among other things, the colors for background, text, and links
;; (including the recently visited links - VLINK). In accord with the
;; HTML specification, colors are specified by six-digit/character
;; numbers which correspond to three two-digit hexadecimal numbers with
;; one pair of digits for each RGB (red, green and blue) component.
;; Below, I've chosen black text (#000000) on a white background
;; (#FFFFFF) except in the title bar which displays black text on
;; a greenish background (#669999), greenish text for the unvisited
;; links (#669999) and lavender text for the visited ones (#996699).
(define (body-attributes)
(format
"BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\" LINK=\"#669999\" VLINK=\"#996699\""))
(define (table-attributes)
(format
"BGCOLOR=\"#669999\" BORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"2\" WIDTH=\"100%\""))
;; Define a global database for information about journal entries.
(define journal-database ())
;; Load the PLT Mzlib List Utilities: list.ss
(require (lib "list.ss"))
;; Call this function to update the entire web site.
(define (update-website)
(read-from-file-journal-database)
;; Update the records for all entries.
(update-journal-database)
;; Sort the records by the entry paths.
(set! journal-database
(mergesort journal-database
(lambda (r s)
(string<? (record-entry-path r)
(record-entry-path s)))))
(write-to-file-journal-database)
;; Build all of the journal entry pages.
(build-journal-entry-pages)
;; Compile data on all index items.
(compile-journal-indices)
;; Build the subject index page:
(build-journal-index-page)
;; Build the table of contents page:
(build-table-of-contents-page)
;; Build the bibliography page:
(build-bibliography-page)
;; Build a web page displaying this code.
(if (update-builder-html?)
(build-web-builder-page)))
;; Write the journal database to a file to simplify updates.
(define (write-to-file-journal-database)
(let ((output ())
(file (build-path journal-directory-absolute
journal-code-directory-relative
"journal-database.scm")))
(if (file-exists? file) (delete-file file))
(set! output (open-output-file file))
(write journal-database output)
(close-output-port output)))
;; Read in the journal database from a file if it exists.
(define (read-from-file-journal-database)
(let ((input ())
(file (build-path journal-directory-absolute
journal-code-directory-relative
"journal-database.scm")))
(if (not (file-exists? file))
(set! journal-database ())
(and (set! input (open-input-file file))
(set! journal-database (read input))
(close-input-port input)))))
;; A journal entry database record consists of five fields:
;;
;; entry path - the file-system path for the entry
;; previous entry path - the path for the previous entry
;; next entry path - the path for the next entry
;; entry date - the date of the entry
;; entry title - the title of the entry
;;
;; All entry paths are relative to the entries directory defined
;; above and, by convention, the first and second lines of each
;; entry correspond, respectively, to the entry's date and title.
;; Records are implemented as lists with the following access
;; procedures to extract the five fields described above.
(define (record-entry-path record) (car record))
(define (record-previous-entry-path record) (car (cdr record)))
(define (record-next-entry-path record) (car (cddr record)))
(define (record-entry-date record) (car (cdddr record)))
(define (record-entry-title record) (car (cddddr record)))
;; The following procedures serve to find, change and add records.
(define (record-lookup record-id)
(assoc record-id journal-database))
(define (record-insert new-record)
(set! journal-database
(cons new-record journal-database)))
(define (record-update old-record new-record)
(set-cdr! old-record (cdr new-record)))
;; Create a new record from an journal entry path.
(define (make-record entry entries)
(let ((input (open-input-file
(build-path journal-directory-absolute
journal-entries-directory-relative
entry "day.txt")))
(offset (length (member entry entries)))
(number-of-entries (length entries))
(record ()))
(set! record
(list entry
;; Grab the path for the previous entry.
(if (> (- number-of-entries offset) 0)
(list-ref entries (- (- number-of-entries offset) 1))
())
;; Grab the path for the next entry.
(if (> offset 1)
(list-ref entries (+ (- number-of-entries offset) 1))
())
;; Grab the date line.
(read-line input)
;; Grab the title line.
(read-line input)))
(close-input-port input)
record))
;; Update all of the records in the journal database.
(define (update-journal-database)
(let ((entries (collect-all-entries)))
(map (lambda (entry)
(update-entry entry entries))
entries)))
;; Collect the paths (relative to the journal entries sub directory)
;; for all of the journal entries in the entries sub directory. This
;; is a little funky the way it changes the current directory and uses
;; relative paths but it works and I didn't want to bother changing it
(define (collect-all-entries)
(current-directory (build-path journal-directory-absolute
journal-entries-directory-relative))
(let ((years (journal-directories-only (directory-list))) (result ()))
(apply append
(map (lambda (year)
(current-directory year)
(set! result (collect-year year))
(current-directory "../")
result)
years))))
(define (collect-year year)
(let ((months (journal-directories-only (directory-list))) (result ()))
(apply append
(map (lambda (month)
(current-directory month)
(set! result (collect-month year month))
(current-directory "../")
result)
months))))
(define (collect-month year month)
(let ((days (journal-directories-only (directory-list))) (result ()))
(map (lambda (day)
(current-directory day)
(set! result (collect-day year month day))
(current-directory "../")
result)
days)))
(define (collect-day year month day)
(build-path year month day))
;; Update the database record for a journal entry.
(define (update-entry entry entries)
(let ((old-record (record-lookup entry))
(new-record (make-record entry entries)))
(cond ((and old-record
(equal? old-record new-record)))
(old-record
(let ((file (build-path journal-directory-absolute
journal-entries-directory-relative
entry "day.htm")))
(if (file-exists? file) (delete-file file))
(record-update old-record new-record)))
(else (record-insert new-record)))))
;; Eliminate all but those directories corresponding
;; to years (02), months (01-12) or days (01-31).
(define (journal-directories-only names)
(if (null? names)
(list)
(if (and (string->number (car names))
(directory-exists? (car names)))
(cons (car names)
(journal-directories-only (cdr names)))
(journal-directories-only (cdr names)))))
;; Build the journal entry pages for every journal
;; entry listed in the journal database.
(define (build-journal-entry-pages)
(map (lambda (record)
(if (update-entry-html? (record-entry-path record))
(build-journal-entry-page record)))
journal-database))
;; It's appropriate to regenerate a day.htm file for a given
;; journal entry when day.htm doesn't exist or when the last
;; modification date for day.txt is more recent than the last
;; modification date for day.htm in the specified directory.
(define (update-entry-html? entry-path)
(let ((root (build-path journal-directory-absolute
journal-entries-directory-relative
entry-path)))
(update-html? (build-path root "day.txt")
(build-path root "day.htm"))))
(define (update-builder-html?)
(let ((root (build-path journal-directory-absolute
journal-code-directory-relative)))
(update-html? (build-path root "builder.scm")
(build-path root "builder.htm"))))
(define (update-html? source-file html-file)
(or (not (file-exists? html-file))
(> (file-or-directory-modify-seconds source-file)
(file-or-directory-modify-seconds html-file))))
;; Define a global database of information about index items.
(define journal-indices ())
;; Build the global database of journal indices.
(define (compile-journal-indices)
(set! journal-indices ())
(map compile-indices journal-database)
;; The first sort places all the capitalized items at the front
;; of the list and the second, using the case-insensitive
;; string-comparison function, reinserts the capitalized items.
;; This two-step sorting method produces a stable sort.
(set! journal-indices
(mergesort (mergesort journal-indices
(lambda (x y)
(string<? (car x) (car y))))
(lambda (x y)
(string-ci<? (car x) (car y))))))
;; Extract the indices in a given journal entry.
(define (compile-indices record)
(let ((input (open-input-file
(build-path journal-directory-absolute
journal-entries-directory-relative
(record-entry-path record)
"day.txt"))))
(aux-compile-indices input record)
(close-input-port input)))
(define aux-compile-indices
(let ((index-pattern (regexp "NAME=\"index-.*?\""))
(pre-replacement-pattern (regexp "NAME=\"index-"))
(post-replacement-pattern (regexp "\"")))
(lambda (input record)
(let ((match (regexp-match index-pattern input)))
(when match
(update-indices
(regexp-replace post-replacement-pattern
(regexp-replace pre-replacement-pattern
(car match) "")
"")
record)
(aux-compile-indices input record))))))
(define (update-indices index-string record)
(let ((index (assoc index-string journal-indices)))
(if index
(set-cdr! index
(cons (record-entry-path record)
(cdr index)))
(set! journal-indices
(cons (list index-string (record-entry-path record))
journal-indices)))))
;; Build the web page containing the journal subject index.
(define (build-journal-index-page)
(let ((file (build-path journal-directory-absolute
journal-supplements-directory-relative
"index.htm"))
(output ()))
(if (file-exists? file) (delete-file file))
(set! output (open-output-file file))
;; Generate the preliminary HTML formatting.
(fprintf output "~
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<HTML>
<HEAD>
<TITLE>Subject Index</TITLE>
</HEAD>
<BODY ~A>
<TABLE ~A>
<TR>
<TD>
<H1>Subject Index</H1>
</TD>
</TR>
</TABLE>
<P>
<UL>~%"
(body-attributes)
(table-attributes))
;; Format the journal indices.
(map (lambda (index)
(build-journal-index output index))
journal-indices)
;; Finish off the formatting and close off any open tags.
(fprintf output "~
</UL>
</BODY>
</HTML>~%")
;; Close the output file.
(close-output-port output)))
;; A journal index of the form:
;; ("processes" "02/07/03" "02/08/08")
;; should appear in the browser as:
;; operating systems, 02/07/03, 02/08/08
;; as generated by the following HTML code:
;; <LI>
;; <B>operating systems</B>,
;; <A href="../02/07/03/day.htm#index-process">02/07/03</A>,
;; <A href="../02/08/08/day.htm#index-process">02/08/08</A>
;; </LI>
(define (build-journal-index output index)
(let ((index-string (car index)) (entry-paths (cdr index)))
(fprintf output "<LI>~%<B>~A</B>,~%"
(regexp-replace*
" hyphen " (regexp-replace*
"-" (regexp-replace*
"-comma" (regexp-replace*
"-period" (regexp-replace*
"-apostrophe-" index-string
"'")
".")
",")
" ")
"-"))
(aux-build-journal-index output index-string
(mergesort entry-paths string<?))
(fprintf output "</LI>~%")))
(define (aux-build-journal-index output index-string entry-paths)
(fprintf output "<A href=\"~A\">~A</A>"
(build-path "../entries"
(car entry-paths)
(string-append "day.htm#index-" index-string))
(car entry-paths))
(if (null? (cdr entry-paths))
(fprintf output "~%")
(and (fprintf output ",~%")
(aux-build-journal-index output index-string
(cdr entry-paths)))))
;; Construct the web page file, day.htm, for the journal
;; entry corresponding to a provided journal record.
(define (build-journal-entry-page record)
(let ((output-file (build-path journal-directory-absolute
journal-entries-directory-relative
(record-entry-path record)
"day.htm"))
(input-file (build-path journal-directory-absolute
journal-entries-directory-relative
(record-entry-path record)
"day.txt"))
(input ()) (output ()))
(if (file-exists? output-file) (delete-file output-file))
(fprintf (current-output-port) "Updating ~A~%" (record-entry-path record))
(set! output (open-output-file output-file))
;; Generate the preliminary HTML formatting, including
;; the running banner head, initial heading and the first
;; part of the code to support navigation between entries.
(fprintf output "~
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<HTML>
<HEAD>
<TITLE>~A</TITLE>
</HEAD>
<BODY ~A>
<TABLE ~A>
<TR>
<TD>
<H2>~A</H2>
</TD>
</TR>
</TABLE>
<P>
<CENTER>
<TABLE BORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"2\" WIDTH=\"200\">
<TR>~%"
(record-entry-date record)
(body-attributes)
(table-attributes)
(record-entry-title record))
;; Add navigation for the previous entry if it exists.
(if (not (null? (record-previous-entry-path record)))
(fprintf output "~
<TD WIDTH=\"80\" ALIGN=\"center\">
<A href=\"~A\">
<IMG src=\"../../../../images/previous.gif\"
HEIGHT=\"30\" WIDTH=\"30\" BORDER=\"0\" ALT=\"Previous\">
</A>
</TD>~%"
(build-path "../../../"
(record-previous-entry-path record)
"day.htm")))
;; Add navigation to get back to the DoCS.htm page.
(fprintf output "~
<TD WIDTH=\"80\" ALIGN=\"center\">
<A href=\"~A\">
<IMG src=\"../../../../images/home.gif\"
HEIGHT=\"30\" WIDTH=\"30\" BORDER=\"0\" ALT=\"Home\">
</A>
</TD>~%"
(build-path "../../../../" "DoCS.htm"))
;; Add navigation for the next entry if it exists.
(if (not (null? (record-next-entry-path record)))
(fprintf output "~
<TD WIDTH=\"80\" ALIGN=\"center\">
<A href=\"~A\">
<IMG src=\"../../../../images/next.gif\"
HEIGHT=\"30\" WIDTH=\"30\" BORDER=\"0\" ALT=\"Next\">
</A>
</TD>~%"
(build-path "../../../"
(record-next-entry-path record)
"day.htm")))
;; Complete the HTML formatting for the navigation code.
(fprintf output "~
</TR>
</TABLE>
</CENTER>
</P>~%")
;; Insert the text for the body of the journal entry.
(if (not (file-exists? input-file))
(format "No file by the name of ~A." input-file)
(and (set! input (open-input-file input-file))
;; Ignore the first two lines of every entry.
(read-line input) (read-line input)
(insert-text input output)
;; Close the input file.
(close-input-port input)))
;; Finish off the formatting and close off any open tags.
(fprintf output "~
</BODY>
</HTML>~%")
;; Close the output file.
(close-output-port output)))
;; Insert the contents of the input file into the output file.
(define (insert-text input output)
(let ((line "empty"))
(set! line (read-line input))
(if (not (eof-object? line))
(and (fprintf output "~A~n" line)
(insert-text input output)))))
;; Build the home page for the journal including the ToC.
(define (build-table-of-contents-page)
(let ((file (build-path journal-directory-absolute "DoCS.htm"))
(output ()))
(if (file-exists? file) (delete-file file))
(set! output (open-output-file file))
;; Generate the preliminary HTML formatting.
(fprintf output "~
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<HTML>
<HEAD>
<TITLE>Diary of a Computer Scientist</TITLE>
</HEAD>
<BODY ~A>
<TABLE ~A>
<TR>
<TD>
<H1>Diary of a Computer Scientist</H1>
</TD>
</TR>
</TABLE>
<H2>Journal Entries</H2>
<UL>~%"
(body-attributes)
(table-attributes))
;; Add a list item for each journal entry.
(map (lambda (record)
(fprintf output "~
<LI>
<I><A href=\"~A\">~A</A></I> - ~A
</LI>~%"
(build-path journal-entries-directory-relative
(record-entry-path record)
"day.htm")
(record-entry-date record)
(record-entry-title record)))
journal-database)
;; Finish off the formatting and close off any open tags.
(fprintf output "~
</UL>
<HR>
<H2>Supplements</H2>
<UL>
<LI>
<A href=\"supplements/index.htm\">Subject Index</A>
</LI>
<LI>
<A href=\"supplements/bib.htm\">Bibliography</A>
</LI>
<LI>
<A href=\"supplements/tours.htm\">Eclectic Tours</A>
</LI>
</UL>
</BODY>
</HTML>~%")
;; Close the output file.
(close-output-port output)))
;; Create the web page containing the bibliography references.
(define (build-bibliography-page)
(let ((output-file (build-path journal-directory-absolute
journal-supplements-directory-relative
"bib.htm"))
(input-file (build-path journal-directory-absolute
journal-supplements-directory-relative
"bib.txt"))
(output ()) (input ()))
(if (file-exists? output-file) (delete-file output-file))
(set! output (open-output-file output-file))
;; Generate the preliminary HTML formatting.
(fprintf output "~
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<HTML>
<HEAD>
<TITLE>Bibliography</TITLE>
</HEAD>
<BODY ~A>
<TABLE ~A>
<TR>
<TD>
<H1>Bibliography</H1>
</TD>
</TR>
</TABLE>~%"
(body-attributes)
(table-attributes))
;; Insert the text for the body of the bibliography.
(if (not (file-exists? input-file))
(format "No file by the name of ~A." input-file)
(and (set! input (open-input-file input-file))
(insert-text input output)
;; Close the input file.
(close-input-port input)))
;; Finish off the formatting and close off any open tags.
(fprintf output "~
</BODY>
</HTML>~%")
;; Close the output file.
(close-output-port output)))
;; Create the web page for displaying this code.
(define (build-web-builder-page)
(let ((file (build-path journal-directory-absolute
journal-code-directory-relative
"builder.htm"))
(output ()))
(if (file-exists? file) (delete-file file))
(set! output (open-output-file file))
;; Generate the preliminary HTML formatting.
(fprintf output "~
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<HTML>
<HEAD>
<TITLE>PLT Scheme DoCS Web Site Generator Code</TITLE>
</HEAD>
<HR>
<BR>
<PRE>~%")
;; Insert the code after reformatting embedded HTML tags.
(insert-code output)
;; Finish off the formatting and close off any open tags.
(fprintf output "~
</PRE>
<BR>
<HR>
</BODY>
</HTML>~%")
;; Close the output file.
(close-output-port output)))
;; Read this file - the Scheme code for the web site builder.
(define (insert-code output)
(let ((input (open-input-file
(build-path journal-directory-absolute
journal-code-directory-relative
"builder.scm"))))
(aux-insert-code input output)
(close-input-port input)))
(define (aux-insert-code input output)
(let ((line "empty"))
(set! line (read-line input))
(if (not (eof-object? line))
;; Substitute escape sequences for HTML reserved characters.
(and (set! line (regexp-replace* "\\&" line "\\&"))
(set! line (regexp-replace* "<" line "\\<"))
(set! line (regexp-replace* ">" line "\\>"))
(fprintf output "~A~n" line)
(aux-insert-code input output)))))
;; Here's a litle interactive script to simplify updates.
(define update
(let ((last-modification-date ())
(file (build-path journal-directory-absolute
journal-code-directory-relative
"builder.scm")))
(set! last-modification-date
(file-or-directory-modify-seconds file))
(lambda ()
;; Update the last modification date for this file.
;; Strip off the last carriage return.
(read-string 1)
;; Ask whether to stop or continue.
(fprintf (current-output-port) "~%Update (y or n): ")
(if (equal? (read-string 1) "y")
(cond ((> (file-or-directory-modify-seconds file)
last-modification-date)
(set! last-modification-date
(file-or-directory-modify-seconds file))
(fprintf (current-output-port)
"~%Reloading \"builder.scm\"~%")
(load file)
(update-website) (update))
(else (update-website) (update)))
(fprintf (current-output-port) "~%Done.~%")))))