doc: Extract (localization) module.

* doc/build.scm (localization-helper-module): New procedure.
(html-manual-indexes)[build]: Use it.  Remove use of GUILE-JSON-3.
This commit is contained in:
Ludovic Courtès 2022-01-17 22:28:52 +01:00
parent 6edcf688c0
commit 62fc6fdb4c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -825,25 +825,24 @@ from SOURCE."
(computed-file "guix-manual-po" build))
(define* (html-manual-indexes source
#:key (languages %languages)
(version "0.0")
(manual %manual)
(title (if (string=? "guix" manual)
"GNU Guix Reference Manual"
"GNU Guix Cookbook"))
(date 1))
(define build
(define* (localization-helper-module source
#:optional (languages %languages))
"Return a file-like object for use as the (localization) module. SOURCE
must be the Guix top-level source directory, from which PO files are taken."
(define content
(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-module (localization)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:export (normalize
with-language
translate
language-code->name
seconds->string))
(define (normalize language) ;XXX: deduplicate
;; Normalize LANGUAGE. For instance, "zh_CN" becomes "zh-cn".
@ -884,17 +883,58 @@ from SOURCE."
;; regardless of $LANGUAGE, we have to spawn a new process each
;; time we want to translate to a different language. Bah!
(let* ((pipe (open-pipe* OPEN_READ
#+(file-append guile-2.2
#+(file-append guile-3.0
"/bin/guile")
"-c" (object->string exp)))
(str (read pipe)))
(close-pipe pipe)
str)))
(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 (seconds->string seconds language)
(let* ((time (make-time time-utc 0 seconds))
(date (time-utc->date time)))
(with-language language (date->string date "~e ~B ~Y"))))
(with-language language (date->string date "~e ~B ~Y")))))))
(scheme-file "localization.scm" content))
(define* (html-manual-indexes source
#:key (languages %languages)
(version "0.0")
(manual %manual)
(title (if (string=? "guix" manual)
"GNU Guix Reference Manual"
"GNU Guix Cookbook"))
(date 1))
(define build
(with-imported-modules `((guix build utils)
((localization)
=> ,(localization-helper-module
source languages)))
#~(begin
(use-modules (guix build utils)
(localization)
(sxml simple)
(srfi srfi-1))
(define (guix-url path)
(string-append #$%web-site-url path))
@ -972,26 +1012,6 @@ from SOURCE."
".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 #$title)
(sxml-index
@ -1034,7 +1054,7 @@ languages:\n"
'#$languages)
(write-html (string-append #$output "/index.html")
(top-level-index '#$languages))))))
(top-level-index '#$languages)))))
(computed-file "html-indexes" build))