diff options
| -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 ...) |