summaryrefslogtreecommitdiff
path: root/doc/build.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-10-19 13:21:26 +0200
committerLudovic Courtès <ludo@gnu.org>2020-10-19 13:28:38 +0200
commitd66a4eac4402614a1938fdc4ef0fde0c06badb52 (patch)
tree1a43465b83c11f6b9ed0f26e4e762bc9ca2c312b /doc/build.scm
parenta9105c2c4c97ffbdb1b09dadc14773566924ab59 (diff)
doc: Produce stylable HTML for @deftp, @deffn, etc.
'makeinfo --help' uses <strong> and <em> for those entries. Replace that with CSS classes. * doc/build.scm (html-manual-identifier-index)[build]: Adjust to handle rewritten forms of <dt> entries. * doc/build.scm (syntax-highlighted-html)[build][syntax-highlight]: Handle <dt> forms and replace them. [highlight-definition, space?]: New procedures.
Diffstat (limited to 'doc/build.scm')
-rw-r--r--doc/build.scm30
1 files changed, 28 insertions, 2 deletions
diff --git a/doc/build.scm b/doc/build.scm
index dac62493f4..7d17a16d2a 100644
--- a/doc/build.scm
+++ b/doc/build.scm
@@ -298,13 +298,17 @@ actual file name."
(loop rest))
((('strong _ ...) _ ...)
#t)
- (_ #f))))
+ ((('span ('@ ('class "symbol-definition-category"))
+ (? string-or-entity?) ...) rest ...)
+ #t)
+ (x
+ #f))))
(let ((shtml (call-with-input-file file html->shtml)))
(let loop ((shtml shtml)
(anchors anchors))
(match shtml
- (('dt ('@ ('id id)) rest ...)
+ (('dt ('@ ('id id) _ ...) rest ...)
(if (and (string-prefix? "index-" id)
(worthy-entry? rest))
(alist-cons (anchor-id->key id)
@@ -479,6 +483,19 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(pk 'unsupported-code-snippet something)
(primitive-exit 1)))))
+ (define (highlight-definition id category symbol args)
+ ;; Produce stylable HTML for the given definition (an @deftp,
+ ;; @deffn, or similar).
+ `(dt (@ (id ,id) (class "symbol-definition"))
+ (span (@ (class "symbol-definition-category"))
+ ,@category)
+ (span (@ (class "symbol-definition-prototype"))
+ ,symbol " " ,@args)))
+
+ (define (space? obj)
+ (and (string? obj)
+ (string-every char-set:whitespace obj)))
+
(define (syntax-highlight sxml anchors)
;; Recurse over SXML and syntax-highlight code snippets.
(let loop ((sxml sxml))
@@ -497,6 +514,15 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(highlight lex-scheme
(concatenate-snippets code-snippet)))
anchors)))
+
+ ;; Replace the ugly <strong> used for @deffn etc., which
+ ;; translate to <dt>, with more stylable markup.
+ (('dt (@ ('id id)) category ... ('strong thing))
+ (highlight-definition id category thing '()))
+ (('dt (@ ('id id)) category ... ('strong thing)
+ (? space?) ('em args ...))
+ (highlight-definition id category thing args))
+
((tag ('@ attributes ...) body ...)
`(,tag (@ ,@attributes) ,@(map loop body)))
((tag body ...)