doc: Avoid invalid 'match' pattern in 'syntax-highlighted-html'.

This is a followup to da9deba13d.

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 ...).
This commit is contained in:
Ludovic Courtès 2020-04-13 02:09:09 +02:00
parent f37789a523
commit 4487e42cba
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 7 deletions

View File

@ -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)