me
/
guix
Archived
1
0
Fork 0
Code

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 ...).
master
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
doc/build.scm
View File

@ -373,17 +373,26 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(('*ENTITY* _ ...) #t) (('*ENTITY* _ ...) #t)
(_ #f))) (_ #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 ((shtml (call-with-input-file file html->shtml)))
(let loop ((shtml shtml) (let loop ((shtml shtml)
(vhash vhash)) (vhash vhash))
(match shtml (match shtml
;; Attempt to match: (('dt ('@ ('id id)) rest ...)
;; <dt>Scheme Variable: <strong>x</strong></dt> (if (and (string-prefix? "index-" id)
;; but not: (worthy-entry? rest))
;; <dt><code>cups-configuration</code> parameter: …</dt>
(('dt ('@ ('id id))
(? string-or-entity?) ... ('strong _ ...) _ ...)
(if (string-prefix? "index-" id)
(vhash-cons (anchor-id->key id) (vhash-cons (anchor-id->key id)
(string-append (basename file) (string-append (basename file)
"#" id) "#" id)