diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-10-19 13:21:26 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-10-19 13:28:38 +0200 |
| commit | d66a4eac4402614a1938fdc4ef0fde0c06badb52 (patch) | |
| tree | 1a43465b83c11f6b9ed0f26e4e762bc9ca2c312b | |
| parent | a9105c2c4c97ffbdb1b09dadc14773566924ab59 (diff) | |
| download | guix-d66a4eac4402614a1938fdc4ef0fde0c06badb52.tar guix-d66a4eac4402614a1938fdc4ef0fde0c06badb52.tar.gz | |
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.
| -rw-r--r-- | doc/build.scm | 30 |
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 ...) |