Add missing build-html.scm file.

Oops!

1 files changed, 78 insertions, 0 deletions

diff --git a/doc/build-html.scm b/doc/build-html.scm
new file mode 100644
index 0000000..0a30749
--- /dev/null
+++ b/doc/build-html.scm
@@ -0,0 +1,78 @@
+;;; Copyright 2023 David Thompson
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;    http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;; Texinfo's 'makeinfo --html' command generates disappointing HTML.
+;; To deal with it, we post-process the HTML files that it generates
+;; to add in syntax highlighting and a better stylesheet.
+(use-modules (htmlprag)
+             (ice-9 ftw)
+             (ice-9 match)
+             (srfi srfi-1)
+             (syntax-highlight)
+             (syntax-highlight scheme))
+
+(define %html-dir "chickadee.html")
+(define %image-dir (string-append %html-dir "/images"))
+
+;; Work within the context of the docs directory.
+(chdir (dirname (current-filename)))
+
+;; Generate the docs with makeinfo.
+(unless (zero? (system* "makeinfo"
+                        "--html"
+                        "-o" %html-dir
+                        "--css-ref=https://dthompson.us/css/dthompson.css"
+                        "--css-include=manual.css"
+                        "chickadee.texi"))
+  (error "failed to build manual"))
+
+;; Gather up all the HTML files that were generated.
+(define html-files
+  (filter-map (lambda (f)
+                (and (string-suffix? ".html" f)
+                     (string-append %html-dir "/" f)))
+              (scandir %html-dir)))
+
+;; Post-process a single document.
+(define (prettify-sxml sxml)
+  (match sxml
+    ;; Remove the default style.
+    ;;(('style _ ...) "")
+    ;; Highlight Scheme code.
+    (('pre ('@ ('class "lisp")) lines ...)
+     (let ((highlights (highlight lex-scheme (string-concatenate lines))))
+       `(pre (@ (class "lisp"))
+             ,@(highlights->sxml highlights))))
+    ;; Leaf nodes.
+    ((or (? symbol?) (? string?)) sxml)
+    ;; Recursively descend through SXML nodes.  Requires two cases:
+    ;; One for nodes with attributes, and one for nodes without.
+    (((? symbol? tag) ('@ attrs ...) nodes ...)
+     (cons* tag
+            (cons '@ attrs)
+            (map prettify-sxml nodes)))
+    (((? symbol? tag) nodes ...)
+     (cons tag (map prettify-sxml nodes)))))
+
+;; Parse HTML strictly.
+(%strict-tokenizer? #t)
+
+;; Apply post-processing to all HTML files, overwriting their original
+;; contents.
+(for-each (lambda (f)
+            (let ((sxml (call-with-input-file f html->sxml)))
+              (call-with-output-file f
+                (lambda (port)
+                  (write-sxml-html (prettify-sxml sxml) port)))))
+          html-files)