summaryrefslogtreecommitdiff
path: root/doc
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-13 02:09:09 +0200
committerLudovic Courtès <ludo@gnu.org>2020-04-13 02:12:08 +0200
commitc2480d10422f176bf06081de9d601f3b7249a83c (patch)
treea910c165e10edc8a4473866081a266fb49960a13 /doc
parentc9b6b82fae6bbc062153f7ff260719bd0e2f6ea1 (diff)
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')
-rw-r--r--doc/build.scm23
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)