tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-06-13 05:34:05 +02:00
Code Activity

doc: Build with Texinfo 7.

Browse Source 
This is a backport of guix/lernigilo#7 and followup commits.

* doc/build.scm (html-manual-identifier-index)[build]
(collect-anchors): Add clauses matching Texinfo 7 output.
(syntax-highlighted-html)[build](concatenate-snippets): Likewise.
(syntax-highlight):Likewise.
(stylized-html)[stylized-html]: Do not insert <link> tag for ‘%manual-css-url’
since it’s already added by ‘makeinfo’.

Change-Id: I3a51eece053d4fdeeaa72d2642fd4a62695cc3a6
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #8272
This commit is contained in:
Ludovic Courtès
2026-05-01 19:35:36 +02:00
parent b84d3cb9bf
commit ef3dcc29e5
1 changed files with 40 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
doc/build.scm
+40 -22
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019-2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019-2026 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2022 Maxim Cournoyer <maxim@guixotic.coop>
;;; Copyright © 2025 Florian Pelz <pelzflorian@pelzflorian.de>
@@ -324,17 +324,31 @@ actual file name."
((('span ('@ ('class "category")) ;raw Texinfo 6.8
(? string-or-entity?) ...) rest ...)
#t)
((('span ('@ ('class "symbol-definition-category"))
(? string-or-entity?) ...) rest ...)
((('span ;Texinfo 6, post-processed
('@ ('class "symbol-definition-category"))
(? string-or-entity?) ...) rest ...)
#t)
((('span ;Texinfo 7
('@ ('class "category-def")) _ ...)
('span ('strong ('@ ('class "def-name")) _ ...)
_ ...)
rest ...)
#t)
(x
#f))))
(define (definition-class? class)
;; Return true for "deffn def-line", "deftp def-line", etc.
(string-suffix? " def-line" class))
(let ((shtml (call-with-input-file file html->shtml)))
(let loop ((shtml shtml)
(anchors anchors))
(match shtml
(('dt ('@ ('id id) _ ...) rest ...)
((or ('dt ('@ ('id id) _ ...) rest ...) ;Texinfo 6
('dt ('@ ('class (? definition-class?)) ;Texinfo 7
('id id))
rest ...))
(if (and (string-prefix? "index-" id)
(worthy-entry? rest))
(alist-cons (anchor-id->key id)
@@ -505,10 +519,16 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(loop rest (cons str strings)))
((('*ENTITY* "additional" entity) . rest)
(loop rest (cons (entity->string entity) strings)))
((('*ENTITY* "additional-char" entity) . rest)
(loop rest (cons (string
(integer->char (string->number entity)))
strings)))
((('span _ lst ...) . rest) ;for <span class="roman">
(loop (append lst rest) strings))
((('var name) . rest) ;for @var{name} within @lisp
((('var ('@ _) name) . rest) ;for @var{name} within @lisp
(loop rest (cons name strings))) ;XXX: losing formatting
((('var name) . rest) ;likewise (Texinfo 6)
(loop rest (cons name strings)))
(something
(pk 'unsupported-code-snippet something)
(primitive-exit 1)))))
@@ -537,7 +557,10 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(link (@ (rel "stylesheet")
(type "text/css")
(href #$syntax-css-url)))))
(('pre ('@ ('class "lisp")) code-snippet ...)
((or ('pre ('@ ('class "lisp")) ;Texinfo 6
code-snippet ...)
('pre ('@ ('class "lisp-preformatted"))
code-snippet ...))
`(pre (@ (class "lisp"))
,@(highlights->sxml*
(pair-open/close
@@ -545,14 +568,16 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
(concatenate-snippets code-snippet)))
anchors)))
;; Replace the ugly <strong> used for @deffn etc., which
;; translate to <dt>, with more stylable markup.
;; For Texinfo 6: Replace the ugly <strong> used for @deffn
;; etc., which translate to <dt>, with more stylable
;; markup. No such post-processing is needed for @deffn
;; with Texinfo 7.
(('dt ('@ ('id id)) ;raw Texinfo 6.8
('span ('@ ('class "category")) category ...)
('span ('strong thing)
anchor))
(highlight-definition id category thing '()))
(('dt (@ ('id id))
(('dt ('@ ('id id)) ;ditto
('span ('@ ('class "category")) category ...)
('span ('strong thing)
(? space?) ('em args ...)
@@ -808,16 +833,9 @@ in SOURCE."
(match sxml
(('*TOP* decl body ...)
`(*TOP* ,decl ,@(map loop body)))
(('head elements ...)
;; Add reference to our own manual CSS, which provides
;; support for the language menu.
`(head ,@elements
(link (@ (rel "stylesheet")
(type "text/css")
(href #$manual-css-url)))))
(('body ('@ attributes ...) elements ...)
`(body (@ ,@attributes)
,(navigation-bar
((or ('body ('@ _) elements ...)
('body elements ...))
`(body ,(navigation-bar
;; TODO: Add "Contribute" menu, to report
;; errors, etc.
(list (menu-dropdown
@@ -952,12 +970,12 @@ makeinfo OPTIONS."
(mkdir-p (string-append #$output "/"
(normalize language)))
(setenv "LANGUAGE" language)
(apply invoke #$(file-append texinfo "/bin/makeinfo")
(apply invoke #$(file-append texinfo-7 "/bin/makeinfo")
"-o" (string-append #$output "/"
(normalize language)
"/html_node")
opts)
(apply invoke #$(file-append texinfo "/bin/makeinfo")
(apply invoke #$(file-append texinfo-7 "/bin/makeinfo")
"--no-split"
"-o"
(string-append #$output "/"
@@ -1409,7 +1427,7 @@ commit date (an integer)."
(string-append #+tar "/bin:"
#+xz "/bin:"
#+zstd "/bin:"
#+texinfo "/bin"))
#+texinfo-7 "/bin"))
(invoke "tar" "xf" #$(package-source guile))
(mkdir-p (string-append #$output "/en/html_node"))