ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

doc: Build a top-level index of the manuals.

Browse source 
Suggested by Julien Lepiller.

* doc/build.scm (html-manual-indexes)[build]: Add 'with-extensions'.
(translate): Actually honor DOMAIN.  Add call to 'bindtextdomain' for
ISO-CODES.
(%iso639-languages): New variable.
(language-code->name, top-level-index): New procedures.
Add call to 'write-html' for OUTPUT/index.html.
This commit is contained in:
Ludovic Courtès 2019-07-15 12:33:07 +02:00
parent 21bec78357
commit e591541d36
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 188 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
doc/build.scm
View file

@ -34,6 +34,7 @@
(gnu packages gawk)
(gnu packages gettext)
(gnu packages guile)
(gnu packages iso-codes)
(gnu packages texinfo)
(gnu packages tex)
(srfi srfi-19)
@ -183,7 +184,7 @@ (define build
(ice-9 match))
(define (normalize language)
;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
;; Normalize LANGUAGE. For instance, "zh_CN" becomes "zh-cn".
(string-map (match-lambda
(#\_ #\-)
(chr chr))
@ -365,16 +366,19 @@ (define* (html-manual-indexes source
(manual "guix")
(date 1))
(define build
(with-extensions (list guile-json-3)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(json)
(ice-9 match)
(ice-9 popen)
(sxml simple)
(srfi srfi-1)
(srfi srfi-19))
(define (normalize language) ;XXX: deduplicate
;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
;; Normalize LANGUAGE. For instance, "zh_CN" becomes "zh-cn".
(string-map (match-lambda
(#\_ #\-)
(chr chr))
@ -402,7 +406,10 @@ (define exp
#+(guix-manual-text-domain
source
languages))
(write (gettext ,str "guix-manual"))))
(bindtextdomain "iso_639-3" ;language names
#+(file-append iso-codes
"/share/locale"))
(write (gettext ,str ,domain))))
(with-language language
;; Since the 'gettext' function caches msgid translations,
@ -497,6 +504,47 @@ (define title
".pdf"))))
"PDF")))))))))
(define %iso639-languages
(vector->list
(assoc-ref (call-with-input-file
#+(file-append iso-codes
"/share/iso-codes/json/iso_639-3.json")
json->scm)
"639-3")))
(define (language-code->name code)
"Return the full name of a language from its ISO-639-3 code."
(let ((code (match (string-index code #\_)
(#f code)
(index (string-take code index)))))
(any (lambda (language)
(and (string=? (or (assoc-ref language "alpha_2")
(assoc-ref language "alpha_3"))
code)
(assoc-ref language "name")))
%iso639-languages)))
(define (top-level-index languages)
(define title
"GNU Guix Reference Manual")
(sxml-index
"en" title
`(main
(article
(@ (class "page centered-block limit-width"))
(h2 ,title)
(div
"The GNU Guix Reference Manual is available in the following
languages:\n"
(ul
,@(map (lambda (language)
`(li (a (@ (href ,(normalize language)))
,(translate
(language-code->name language)
language
#:domain "iso_639-3"))))
languages)))))))
(define (write-html file sxml)
(call-with-output-file file
(lambda (port)
@ -508,9 +556,6 @@ (define (write-html file sxml)
(setenv "LC_ALL" "en_US.utf8")
(setlocale LC_ALL "en_US.utf8")
(bindtextdomain "guix-manual"
#+(guix-manual-text-domain source languages))
(for-each (lambda (language)
(define directory
(string-append #$output "/"
@ -519,7 +564,10 @@ (define directory
(mkdir-p directory)
(write-html (string-append directory "/index.html")
(language-index language)))
'#$languages))))
'#$languages)
(write-html (string-append #$output "/index.html")
(top-level-index '#$languages))))))
(computed-file "html-indexes" build))