me
/
guix
Archived
1
0
Fork 0

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.
master
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
# build-side modules with unusual dependencies.
MODULES_NOT_COMPILED = \
guix/build/po.scm \
guix/man-db.scm
include gnu/local.mk

69
guix/build/po.scm 100644
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))
("bzip2" (ref '(gnu packages compression) 'bzip2))
("xz" (ref '(gnu packages compression) 'xz))
("po4a" (ref '(gnu packages gettext) 'po4a))
("gettext" (ref '(gnu packages gettext) 'gettext-minimal))
(_ #f)))) ;no such package
@ -253,8 +255,134 @@ DOMAIN, a gettext domain."
(computed-file (string-append "guix-locale-" domain)
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)
"Return the Info manual built from SOURCE."
(define po4a
(specification->package "po4a"))
(define gettext
(specification->package "gettext"))
(define texinfo
(module-ref (resolve-interface '(gnu packages texinfo))
'texinfo))
@ -327,6 +455,8 @@ DOMAIN, a gettext domain."
;; see those images and produce image references in the Info output.
(copy-recursively #$documentation "."
#:log (%make-void-port "w"))
(copy-recursively #+(translate-texi-manuals source) "."
#:log (%make-void-port "w"))
(delete-file-recursively "images")
(symlink (string-append #$output "/images") "images")
@ -578,6 +708,7 @@ Info manual."
;; us to avoid an extra dependency on guile-gdbm-ffi.
#:extra-files
`(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))
("guix/build/po.scm" ,(local-file "../guix/build/po.scm"))
("guix/store/schema.sql"
,(local-file "../guix/store/schema.sql")))