blob: 0a307495859297fe9e1c4fd5df51e55ad1dac601 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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)
|
