self: Rebuild translated manuals.

* guix/self.scm (info-manual): Run po4a and related commands to generate
translated texi files before building translated manuals.
* guix/build/po.scm: New file.
* Makefile.am (MODULES_NOT_COMPILED): Add it.
This commit is contained in:
Julien Lepiller 2019-04-26 14:54:52 +02:00
parent 0c329bf4b0
commit 554b30d2ac
No known key found for this signature in database
GPG Key ID: 43111F4520086A0C
3 changed files with 201 additions and 0 deletions

View File

@ -54,6 +54,7 @@ nodist_noinst_SCRIPTS = \
# Modules that are not compiled but are installed nonetheless, such as # Modules that are not compiled but are installed nonetheless, such as
# build-side modules with unusual dependencies. # build-side modules with unusual dependencies.
MODULES_NOT_COMPILED = \ MODULES_NOT_COMPILED = \
guix/build/po.scm \
guix/man-db.scm guix/man-db.scm
include gnu/local.mk include gnu/local.mk

69
guix/build/po.scm Normal file
View File

@ -0,0 +1,69 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build po)
#:use-module (ice-9 match)
#:use-module (ice-9 peg)
#:use-module (ice-9 regex)
#:use-module (ice-9 textual-ports)
#:export (read-po-file))
;; A small parser for po files
(define-peg-pattern po-file body (* (or comment entry whitespace)))
(define-peg-pattern whitespace body (or " " "\t" "\n"))
(define-peg-pattern comment-chr body (range #\space #\頋))
(define-peg-pattern comment none (and "#" (* comment-chr) "\n"))
(define-peg-pattern entry all
(and (ignore (* whitespace)) (ignore "msgid ") msgid
(ignore (* whitespace)) (ignore "msgstr ") msgstr))
(define-peg-pattern escape body (or "\\\\" "\\\"" "\\n"))
(define-peg-pattern str-chr body (or " " "!" (and (ignore "\\") "\"")
"\\n" (and (ignore "\\") "\\")
(range #\# #\頋)))
(define-peg-pattern msgid all content)
(define-peg-pattern msgstr all content)
(define-peg-pattern content body
(and (ignore "\"") (* str-chr) (ignore "\"")
(? (and (ignore (* whitespace)) content))))
(define (parse-tree->assoc parse-tree)
"Converts a po PARSE-TREE to an association list."
(define regex (make-regexp "\\\\n"))
(match parse-tree
('() '())
((entry parse-tree ...)
(match entry
((? string? entry)
(parse-tree->assoc parse-tree))
;; empty msgid
(('entry ('msgid ('msgstr msgstr)))
(parse-tree->assoc parse-tree))
;; empty msgstr
(('entry ('msgid msgid) 'msgstr)
(parse-tree->assoc parse-tree))
(('entry ('msgid msgid) ('msgstr msgstr))
(acons (regexp-substitute/global #f regex msgid 'pre "\n" 'post)
(regexp-substitute/global #f regex msgstr 'pre "\n" 'post)
(parse-tree->assoc parse-tree)))))))
(define (read-po-file port)
"Read a .po file from PORT and return an alist of msgid and msgstr."
(let ((tree (peg:tree (match-pattern
po-file
(get-string-all port)))))
(parse-tree->assoc tree)))

View File

@ -60,6 +60,8 @@
("gzip" (ref '(gnu packages compression) 'gzip)) ("gzip" (ref '(gnu packages compression) 'gzip))
("bzip2" (ref '(gnu packages compression) 'bzip2)) ("bzip2" (ref '(gnu packages compression) 'bzip2))
("xz" (ref '(gnu packages compression) 'xz)) ("xz" (ref '(gnu packages compression) 'xz))
("po4a" (ref '(gnu packages gettext) 'po4a))
("gettext" (ref '(gnu packages gettext) 'gettext-minimal))
(_ #f)))) ;no such package (_ #f)))) ;no such package
@ -253,8 +255,134 @@ DOMAIN, a gettext domain."
(computed-file (string-append "guix-locale-" domain) (computed-file (string-append "guix-locale-" domain)
build)) build))
(define (translate-texi-manuals source)
"Return the translated texinfo manuals built from SOURCE."
(define po4a
(specification->package "po4a"))
(define gettext
(specification->package "gettext"))
(define glibc-utf8-locales
(module-ref (resolve-interface '(gnu packages base))
'glibc-utf8-locales))
(define documentation
(file-append* source "doc"))
(define documentation-po
(file-append* source "po/doc"))
(define build
(with-imported-modules '((guix build utils) (guix build po))
#~(begin
(use-modules (guix build utils) (guix build po)
(ice-9 match) (ice-9 regex) (ice-9 textual-ports)
(srfi srfi-1))
(mkdir #$output)
(copy-recursively #$documentation "."
#:log (%make-void-port "w"))
(for-each
(lambda (file)
(copy-file file (basename file)))
(find-files #$documentation-po ".*.po$"))
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales "/lib/locale"))
(setenv "PATH" #+(file-append gettext "/bin"))
(setenv "LC_ALL" "en_US.UTF-8")
(setlocale LC_ALL "en_US.UTF-8")
(define (translate-tmp-texi po source output)
"Translate Texinfo file SOURCE using messages from PO, and write
the result to OUTPUT."
(invoke #+(file-append po4a "/bin/po4a-translate")
"-M" "UTF-8" "-L" "UTF-8" "-k" "0" "-f" "texinfo"
"-m" source "-p" po "-l" output))
(define (make-ref-regex msgid end)
(make-regexp (string-append
"ref\\{"
(string-join (string-split (regexp-quote msgid) #\ )
"[ \n]+")
end)))
(define (translate-cross-references content translations)
"Take CONTENT, a string representing a .texi file and translate any
cross-reference in it (@ref, @xref and @pxref) that have a translation in
TRANSLATIONS, an alist of msgid and msgstr."
(fold
(lambda (elem content)
(match elem
((msgid . msgstr)
;; Empty translations and strings containing some special characters
;; cannot be the name of a section.
(if (or (equal? msgstr "")
(string-any (lambda (chr)
(member chr '(#\{ #\} #\( #\) #\newline #\,)))
msgid))
content
;; Otherwise, they might be the name of a section, so we
;; need to translate any occurence in @(p?x?)ref{...}.
(let ((regexp1 (make-ref-regex msgid ","))
(regexp2 (make-ref-regex msgid "\\}")))
(regexp-substitute/global
#f regexp2
(regexp-substitute/global
#f regexp1 content 'pre "ref{" msgstr "," 'post)
'pre "ref{" msgstr "}" 'post))))))
content translations))
(define (translate-texi po lang)
"Translate the manual for one language LANG using the PO file."
(let ((translations (call-with-input-file po read-po-file)))
(translate-tmp-texi po "guix.texi"
(string-append "guix." lang ".texi.tmp"))
(translate-tmp-texi po "contributing.texi"
(string-append "contributing." lang ".texi.tmp"))
(let* ((texi-name (string-append "guix." lang ".texi"))
(tmp-name (string-append texi-name ".tmp")))
(with-output-to-file texi-name
(lambda _
(format #t "~a"
(translate-cross-references
(call-with-input-file tmp-name get-string-all)
translations)))))
(let* ((texi-name (string-append "contributing." lang ".texi"))
(tmp-name (string-append texi-name ".tmp")))
(with-output-to-file texi-name
(lambda _
(format #t "~a"
(translate-cross-references
(call-with-input-file tmp-name get-string-all)
translations)))))))
(for-each (lambda (po)
(match (reverse (string-split po #\.))
((_ lang _ ...)
(translate-texi po lang))))
(find-files "." "^guix-manual\\.[a-z]{2}(_[A-Z]{2})?\\.po$"))
(for-each
(lambda (file)
(copy-file file (string-append #$output "/" file)))
(append
(find-files "." "contributing\\..*\\.texi$")
(find-files "." "guix\\..*\\.texi$"))))))
(computed-file "guix-translated-texinfo" build))
(define (info-manual source) (define (info-manual source)
"Return the Info manual built from SOURCE." "Return the Info manual built from SOURCE."
(define po4a
(specification->package "po4a"))
(define gettext
(specification->package "gettext"))
(define texinfo (define texinfo
(module-ref (resolve-interface '(gnu packages texinfo)) (module-ref (resolve-interface '(gnu packages texinfo))
'texinfo)) 'texinfo))
@ -327,6 +455,8 @@ DOMAIN, a gettext domain."
;; see those images and produce image references in the Info output. ;; see those images and produce image references in the Info output.
(copy-recursively #$documentation "." (copy-recursively #$documentation "."
#:log (%make-void-port "w")) #:log (%make-void-port "w"))
(copy-recursively #+(translate-texi-manuals source) "."
#:log (%make-void-port "w"))
(delete-file-recursively "images") (delete-file-recursively "images")
(symlink (string-append #$output "/images") "images") (symlink (string-append #$output "/images") "images")
@ -578,6 +708,7 @@ Info manual."
;; us to avoid an extra dependency on guile-gdbm-ffi. ;; us to avoid an extra dependency on guile-gdbm-ffi.
#:extra-files #:extra-files
`(("guix/man-db.scm" ,(local-file "../guix/man-db.scm")) `(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))
("guix/build/po.scm" ,(local-file "../guix/build/po.scm"))
("guix/store/schema.sql" ("guix/store/schema.sql"
,(local-file "../guix/store/schema.sql"))) ,(local-file "../guix/store/schema.sql")))