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: 643 bytes --]

Le Fri, 26 Apr 2019 13:05:14 +0200,
Miguel <rosen644835@gmail.com> a écrit :

> Hi,
> 
> El Fri, 26 Apr 2019 11:30:04 +0200
> Julien Lepiller <julien@lepiller.eu> escribió:
> > Thank you! I've just pushed it and removed doc/guix.*.texi and
> > doc/contributing.*.texi from the repository, added them
> > to .gitignore too.  
> 
> Thank you very much, my emacs and magit will thank you too, as each
> change in the manual was taking awfully long to refresh. :)
> 
> Best regards,
> Miguel

There was an issue introduced by that patch: the manual was not
generated by guix pull anymore. The attached patch fixes that. WDYT?

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

From d93644846ff954c221c2510755766da3f0e27b5c 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/self.scm | 116 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 115 insertions(+), 1 deletion(-)

diff --git a/guix/self.scm b/guix/self.scm
index 2a10d1d25f..89d3212f52 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
@@ -255,6 +257,12 @@ DOMAIN, a gettext domain."
 
 (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))
@@ -270,6 +278,9 @@ DOMAIN, a gettext domain."
   (define documentation
     (file-append* source "doc"))
 
+  (define documentation-po
+    (file-append* source "po/doc"))
+
   (define examples
     (file-append* source "gnu/system/examples"))
 
@@ -277,6 +288,49 @@ DOMAIN, a gettext domain."
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
+          (use-modules (ice-9 match))
+          (use-modules (ice-9 peg))
+          (use-modules (ice-9 regex))
+          (use-modules (ice-9 textual-ports))
+          (use-modules (srfi srfi-1))
+          
+          ;; 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)))))))
 
           (mkdir #$output)
 
@@ -322,11 +376,15 @@ DOMAIN, a gettext domain."
                     (find-files (string-append #$documentation "/images")
                                 "\\.png$"))
 
-          ;; Finally build the manual.  Copy it the Texinfo files to $PWD and
+          ;; Finally build the manual.  Copy it the Texinfo and po files to $PWD and
           ;; add a symlink to the 'images' directory so that 'makeinfo' can
           ;; see those images and produce image references in the Info output.
           (copy-recursively #$documentation "."
                             #:log (%make-void-port "w"))
+          (for-each
+            (lambda (file)
+              (copy-file file (basename file)))
+            (find-files #$documentation-po ".*.po$"))
           (delete-file-recursively "images")
           (symlink (string-append #$output "/images") "images")
 
@@ -334,6 +392,62 @@ DOMAIN, a gettext domain."
           (setenv "GUIX_LOCPATH"
                   #+(file-append glibc-utf8-locales "/lib/locale"))
 
+          (setenv "LC_ALL" "en_US.UTF-8")
+          (setlocale LC_ALL "en_US.UTF-8")
+
+          (define (create-texi po source texi-name)
+            (let* ((parse-tree
+                     (peg:tree (match-pattern
+                                 po-file
+                                 (call-with-input-file po get-string-all))))
+                   (translations (parse-tree->assoc parse-tree))
+                   (tmp-name (string-append texi-name ".tmp")))
+              (setenv "PATH" #+(file-append gettext "/bin"))
+              (invoke #+(file-append po4a "/bin/po4a-translate")
+                "-M" "UTF-8" "-L" "UTF-8" "-k" "0" "-f" "texinfo"
+                "-m" source "-p" po "-l" tmp-name)
+              (with-output-to-file texi-name
+                (lambda _
+                  (format #t "~a"
+                    (fold
+                      (lambda (elem content)
+                        (let* ((msgid (car elem))
+                               (msgstr (cdr elem)))
+                          (if (or (equal? msgstr "")
+                                  (string-any (lambda (chr)
+                                                (member chr '(#\{ #\} #\( #\)
+                                                              #\newline #\,)))
+                                              msgid))
+                            content
+                            (let ((regexp1
+                                    (make-regexp
+                                      (string-append
+                                        "ref\\{"
+                                        (string-join
+                                          (string-split msgid #\ ) "[ \n]+")
+                                        ","))))
+                            (let ((regexp2
+                                    (make-regexp
+                                      (string-append
+                                        "ref\\{"
+                                        (string-join
+                                          (string-split msgid #\ ) "[ \n]+")
+                                        "\\}"))))
+                              (regexp-substitute/global
+                                #f regexp2
+                                (regexp-substitute/global
+                                  #f regexp1 content 'pre "ref{" msgstr "," 'post)
+                                'pre "ref{" msgstr "}" 'post))))))
+                      (call-with-input-file tmp-name get-string-all)
+                      translations))))))
+          (for-each (lambda (po)
+                      (let ((lang (cadr (reverse (string-split po #\.)))))
+                        (create-texi po "guix.texi"
+                                     (string-append "guix." lang ".texi"))
+                        (create-texi po "contributing.texi"
+                                     (string-append "contributing." lang ".texi"))))
+                    (find-files "." "^guix-manual\\.[a-z]{2}(_[A-Z]{2})?\\.po$"))
+
           (for-each (lambda (texi)
                       (unless (string=? "guix.texi" texi)
                         ;; Create 'version-LL.texi'.
-- 
2.21.0