aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--guix/build/po.scm69
-rw-r--r--guix/self.scm131
3 files changed, 201 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index f25900de0f..05940719cd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
diff --git a/guix/build/po.scm b/guix/build/po.scm
new file mode 100644
index 0000000000..47ff67541c
--- /dev/null
+++ b/guix/build/po.scm
@@ -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)))
diff --git a/guix/self.scm b/guix/self.scm
index 2a10d1d25f..68b87051e9 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -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")))