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.
This commit is contained in:
Ludovic Courtès 2020-10-19 13:21:26 +02:00
parent a9105c2c4c
commit d66a4eac44
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -298,13 +298,17 @@ (define (worthy-entry? lst)
(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 @@ (define (concatenate-snippets pieces)
(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 @@ (define (syntax-highlight sxml anchors)
(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 ...)