From d93644846ff954c221c2510755766da3f0e27b5c Mon Sep 17 00:00:00 2001 From: Julien Lepiller 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 @@ -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