Re: [PATCH 1/2] bootstrap: Break automake dependency on generated files. (was Re: Let’s translate!)

[Julien Lepiller <julien@lepiller.eu>]

[-- Attachment #1: Type: text/plain, Size: 206 bytes --]

Le Sat, 27 Apr 2019 00:10:04 +0200,
Ludovic Courtès <ludo@gnu.org> a écrit :

> Hi Julien!
> 
> 
> Could you send an updated patch?
> 
> Thank you!
> 
> Ludo\x19.

Attached is an updated patch.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-self-Rebuild-translated-manuals.patch --]
[-- Type: text/x-patch, Size: 11147 bytes --]

From 77c33ee55115475f582eb49da8dc045432fbdb3b Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Fri, 26 Apr 2019 14:54:52 +0200
Subject: [PATCH] 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): Add it.
---
 Makefile.am       |   1 +
 guix/build/po.scm |  69 +++++++++++++++++++++++++
 guix/self.scm     | 128 +++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 197 insertions(+), 1 deletion(-)
 create mode 100644 guix/build/po.scm

diff --git a/Makefile.am b/Makefile.am
index 99d6ed64b6..272330c3a9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -156,6 +156,7 @@ MODULES =					\
   guix/build/meson-build-system.scm		\
   guix/build/minify-build-system.scm		\
   guix/build/font-build-system.scm		\
+  guix/build/po.scm				\
   guix/build/go-build-system.scm		\
   guix/build/asdf-build-system.scm		\
   guix/build/git.scm				\
diff --git a/guix/build/po.scm b/guix/build/po.scm
new file mode 100644
index 0000000000..3fbe9b2373
--- /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 returns 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..3c60da6308 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
 
 \f
@@ -253,8 +255,130 @@ DOMAIN, a gettext domain."
   (computed-file (string-append "guix-locale-" domain)
                  build))
 
+(define (translate-texi-manuals source)
+  "Retrun 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 tmp-name)
+            (invoke #+(file-append po4a "/bin/po4a-translate")
+              "-M" "UTF-8" "-L" "UTF-8" "-k" "0" "-f" "texinfo"
+              "-m" source "-p" po "-l" tmp-name))
+
+          (define (make-ref-regex msgid end)
+            (make-regexp (string-append
+                           "ref\\{" (string-join (string-split msgid #\ ) "[ \n]+")
+                           end)))
+
+          (define (translate-cross-reference content translations)
+            "Take CONTENT, a string representing a .texi file and translate any
+croos-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-reference
+                        (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-reference
+                        (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))
@@ -277,7 +401,7 @@ DOMAIN, a gettext domain."
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
-
+          
           (mkdir #$output)
 
           ;; Create 'version.texi'.
@@ -327,6 +451,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")
 
-- 
2.21.0