[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: doc: Produce stylable HTML for @deftp, @deffn, etc.
From: |
guix-commits |
Subject: |
02/02: doc: Produce stylable HTML for @deftp, @deffn, etc. |
Date: |
Mon, 19 Oct 2020 07:30:47 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit d66a4eac4402614a1938fdc4ef0fde0c06badb52
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Oct 19 13:21:26 2020 +0200
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.
---
doc/build.scm | 30 ++++++++++++++++++++++++++++--
1 file changed, 28 insertions(+), 2 deletions(-)
diff --git a/doc/build.scm b/doc/build.scm
index dac6249..7d17a16 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 ...)