diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-04-13 02:09:09 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-04-13 02:12:08 +0200 |
| commit | c2480d10422f176bf06081de9d601f3b7249a83c (patch) | |
| tree | a910c165e10edc8a4473866081a266fb49960a13 /doc/build.scm | |
| parent | c9b6b82fae6bbc062153f7ff260719bd0e2f6ea1 (diff) | |
| download | guix-c2480d10422f176bf06081de9d601f3b7249a83c.tar guix-c2480d10422f176bf06081de9d601f3b7249a83c.tar.gz | |
doc: Avoid invalid 'match' pattern in 'syntax-highlighted-html'.
This is a followup to da9deba13d551e316f5a99a614834efa27ddc7d1.
Last-minute modification of the 'match' pattern would lead to an error:
"multiple ellipsis patterns not allowed at same level"
* doc/build.scm (syntax-highlighted-html)[build](collect-anchors):
Add 'worthy-entry?' procedure and use it instead of the unsupported
pattern for ('dt ...).
Diffstat (limited to 'doc/build.scm')
| -rw-r--r-- | doc/build.scm | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/doc/build.scm b/doc/build.scm index c3d61f837b..ca81d813a9 100644 --- a/doc/build.scm +++ b/doc/build.scm @@ -373,17 +373,26 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')." (('*ENTITY* _ ...) #t) (_ #f))) + (define (worthy-entry? lst) + ;; Attempt to match: + ;; Scheme Variable: <strong>x</strong> + ;; but not: + ;; <code>cups-configuration</code> parameter: … + (let loop ((lst lst)) + (match lst + (((? string-or-entity?) rest ...) + (loop rest)) + ((('strong _ ...) _ ...) + #t) + (_ #f)))) + (let ((shtml (call-with-input-file file html->shtml))) (let loop ((shtml shtml) (vhash vhash)) (match shtml - ;; Attempt to match: - ;; <dt>Scheme Variable: <strong>x</strong></dt> - ;; but not: - ;; <dt><code>cups-configuration</code> parameter: …</dt> - (('dt ('@ ('id id)) - (? string-or-entity?) ... ('strong _ ...) _ ...) - (if (string-prefix? "index-" id) + (('dt ('@ ('id id)) rest ...) + (if (and (string-prefix? "index-" id) + (worthy-entry? rest)) (vhash-cons (anchor-id->key id) (string-append (basename file) "#" id) |