amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

doc: Extract (localization) module.

Browse source 
* 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
1 changed files with 208 additions and 188 deletions
Download patch file Download diff file Expand all files Collapse all files

100
doc/build.scm
View file

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