mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
Julien Lepiller
parent
0c329bf4b0
commit
554b30d2ac
3 changed files with 201 additions and 0 deletions
|
|
@ -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
Normal file
69
guix/build/po.scm
Normal 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)))
|
||||
131
guix/self.scm
131
guix/self.scm
|
|
@ -60,6 +60,8 @@ (define specification->package
|
|||
("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 @@ (define (linguas)
|
|||
(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 @@ (define build
|
|||
;; 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 @@ (define *core-modules*
|
|||
;; 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")))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue