maint: Factorize po xref translation.

This ensures we use the same method in "make" as in "guix/self.scm".

* Makefile.am: Build guix/build/po.scm.
* build-aux/convert-xref.scm: New file.
* doc/local.mk (xref_command): Use it.
* guix/self.scm (translate-cross-references): Move it...
* guix/build/po.scm: Parse comments and flags separately to find fuzzy
flags.
(translate-cross-references): ...here.
(parse-tree->assoc): Ignore fuzzy entries.
This commit is contained in:
Julien Lepiller 2021-10-10 22:07:51 +02:00
parent d1b375402f
commit 0623138ffa
No known key found for this signature in database
GPG Key ID: 53D457B2D636EE82
5 changed files with 164 additions and 100 deletions

@ -640,6 +640,7 @@ EXTRA_DIST += \
build-aux/check-final-inputs-self-contained.scm \
build-aux/check-channel-news.scm \
build-aux/compile-as-derivation.scm \
build-aux/convert-xref.scm \
build-aux/generate-authors.scm \
build-aux/test-driver.scm \
build-aux/update-guix-package.scm \
@ -699,8 +700,6 @@ $(1): $(2)
--completed $(3) \
$$(filter %.scm,$$^)
.PHONY: $(1)
endef
# Split compilation in several steps, each of which building a subset of
@ -712,22 +711,31 @@ MODULES_CORE = guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULE
MODULES_PACKAGES = $(filter gnu/packages/%,$(MODULES))
MODULES_SYSTEM = gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES)))
MODULES_CLI = $(filter guix/scripts/%,$(MODULES))
MODULES_PO = guix/build/po.scm
$(eval $(call guile-compilation-rule,make-core-go, \
$(MODULES_CORE) guix/config.scm $(dist_noinst_DATA), \
0))
.PHONY: make-core-go
$(eval $(call guile-compilation-rule,make-packages-go, \
$(MODULES_PACKAGES) make-core-go, \
$(words $(MODULES_CORE))))
.PHONY: make-packages-go
$(eval $(call guile-compilation-rule,make-system-go, \
$(MODULES_SYSTEM) make-packages-go make-core-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES))))
.PHONY: make-system-go
$(eval $(call guile-compilation-rule,make-cli-go, \
$(MODULES_CLI) make-system-go make-packages-go make-core-go, \
$(words $(MODULES_CORE) $(MODULES_PACKAGES) $(MODULES_SYSTEM))))
.PHONY: make-cli-go
$(eval $(call guile-compilation-rule,guix/build/po.go, \
$(MODULES_PO), \
0))
SUFFIXES = .go

@ -0,0 +1,26 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 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/>.
;; Translate cross-references in a translated .texi manual.
(use-modules (guix build po)
(ice-9 match))
(match (command-line)
((program texi pofile)
(translate-cross-references texi pofile)))

@ -97,44 +97,29 @@ PO4A_PARAMS += -k 0 # produce an output even if the translation is not complete
PO4A_PARAMS += -f texinfo # texinfo format
# When a change to guix.texi occurs, it is not translated immediately.
# Because @pxref and @xref commands are reference to a section by name, they
# Because @pxref and @xref commands are references to sections by name, they
# should be translated. If a modification adds a reference to a section, this
# reference is not translated, which means it references a section that does not
# exist.
# This command loops through the translated files looking for references. For
# each of these references, it tries to find the translation and replaces the
# reference name, even in untranslated strings.
# The last sed is a multiline sed because some references span multiple lines.
define xref_command
cat "$@.tmp" | egrep '@p?x?ref' -A1 | sed 'N;s|--\n||g;P;D' | sed 's|^| |g' | \
tr -d '\012' | sed 's|\(@p\?x\?ref\)|\n\1|g' | egrep '@p?x?ref' | \
sed 's|^.*@p\?x\?ref{\([^,}]*\).*$$|\1|g' | sort | uniq | while read e; do \
if [ -n "$$e" ]; then \
line=$$(grep -n "^msgid \"$$e\"" "$<" | cut -f1 --delimiter=":") ;\
((line++)) ;\
if [ "$$line" != "1" ]; then \
translation=$$(head -n "$$line" "$<" | tail -1 | grep msgstr | sed 's|msgstr "\([^"]*\)"|\1|') ;\
if [ "$$translation" != "" ]; then \
sed "N;s@\(p\?x\?ref\){$$(echo $$e | sed 's| |[\\n ]|g')\(,\|}\)@\1{$$translation\2@g;P;D" -i "$@.tmp" ;\
fi ;\
fi ;\
fi ;\
done
$(top_srcdir)/pre-inst-env $(GUILE) --no-auto-compile \
"$(top_srcdir)/build-aux/convert-xref.scm" \
$@.tmp $<
endef
$(srcdir)/%D%/guix.%.texi: po/doc/guix-manual.%.po $(srcdir)/%D%/contributing.%.texi
$(srcdir)/%D%/guix.%.texi: po/doc/guix-manual.%.po $(srcdir)/%D%/contributing.%.texi guix/build/po.go
-$(AM_V_PO4A)$(PO4A_TRANSLATE) $(PO4A_PARAMS) -m "%D%/guix.texi" -p "$<" -l "$@.tmp"
-sed -i "s|guix\.info|$$(basename "$@" | sed 's|texi$$|info|')|" "$@.tmp"
-$(AM_V_POXREF)$(xref_command)
-mv "$@.tmp" "$@"
$(srcdir)/%D%/guix-cookbook.%.texi: po/doc/guix-cookbook.%.po
$(srcdir)/%D%/guix-cookbook.%.texi: po/doc/guix-cookbook.%.po guix/build/po.go
-$(AM_V_PO4A)$(PO4A_TRANSLATE) $(PO4A_PARAMS) -m "%D%/guix-cookbook.texi" -p "$<" -l "$@.tmp"
-sed -i "s|guix-cookbook\.info|$$(basename "$@" | sed 's|texi$$|info|')|" "$@.tmp"
-$(AM_V_POXREF)$(xref_command)
-mv "$@.tmp" "$@"
$(srcdir)/%D%/contributing.%.texi: po/doc/guix-manual.%.po
$(srcdir)/%D%/contributing.%.texi: po/doc/guix-manual.%.po guix/build/po.go
-$(AM_V_PO4A)$(PO4A_TRANSLATE) $(PO4A_PARAMS) -m "%D%/contributing.texi" -p "$<" -l "$@.tmp"
-$(AM_V_POXREF)$(xref_command)
-mv "$@.tmp" "$@"

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2019, 2021 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
@ -20,17 +20,23 @@
(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))
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:export (read-po-file
translate-cross-references))
;; A small parser for po files
(define-peg-pattern po-file body (* (or comment entry whitespace)))
(define-peg-pattern po-file body (* (or 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 flags all (and (ignore "#, ") (* comment-chr) (ignore "\n")))
(define-peg-pattern entry all
(and (ignore (* whitespace)) (ignore "msgid ") msgid
(ignore (* whitespace)) (ignore "msgstr ") msgstr))
(and (* (or flags comment (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 "\\") "\\")
@ -53,7 +59,24 @@
(append (list "\n" prefix) result)))))))
(define (parse-tree->assoc parse-tree)
"Converts a po PARSE-TREE to an association list."
"Converts a po PARSE-TREE to an association list, where the key is the msgid
and the value is the msgstr. The result only contains non fuzzy strings."
(define (comments->flags comments)
(match comments
(('flags flags)
(map (lambda (flag) (string->symbol (string-trim-both flag #\space)))
(string-split flags #\,)))
((? list? comments)
(fold
(lambda (comment res)
(match comment
((? string? _) res)
(flags
(append (comments->flags flags)
res))))
'()
comments))))
(match parse-tree
(() '())
((entry . parse-tree)
@ -66,10 +89,22 @@
;; empty msgstr
(('entry ('msgid msgid) 'msgstr)
(parse-tree->assoc parse-tree))
(('entry _ ('msgid msgid) 'msgstr)
(parse-tree->assoc parse-tree))
(('entry ('msgid msgid) ('msgstr msgstr))
(acons (interpret-newline-escape msgid)
(interpret-newline-escape msgstr)
(parse-tree->assoc parse-tree)))))))
(parse-tree->assoc parse-tree)))
(('entry ('msgid msgid) ('msgstr msgstr))
(acons (interpret-newline-escape msgid)
(interpret-newline-escape msgstr)
(parse-tree->assoc parse-tree)))
(('entry comments ('msgid msgid) ('msgstr msgstr))
(if (member 'fuzzy (comments->flags comments))
(parse-tree->assoc parse-tree)
(acons (interpret-newline-escape msgid)
(interpret-newline-escape msgstr)
(parse-tree->assoc parse-tree))))))))
(define (read-po-file port)
"Read a .po file from PORT and return an alist of msgid and msgstr."
@ -77,3 +112,71 @@
po-file
(get-string-all port)))))
(parse-tree->assoc tree)))
(define (canonicalize-whitespace str)
"Change whitespace (newlines, etc.) in STR to @code{#\\space}."
(string-map (lambda (chr)
(if (char-set-contains? char-set:whitespace chr)
#\space
chr))
str))
(define xref-regexp
;; Texinfo cross-reference regexp.
(make-regexp "@(px|x)?ref\\{([^,}]+)"))
(define (translate-cross-references texi pofile)
"Translate the cross-references that appear in @var{texi}, the initial
translation of a Texinfo file, using the msgid/msgstr pairs from @var{pofile}."
(define translations
(call-with-input-file pofile read-po-file))
(define content
(call-with-input-file texi get-string-all))
(define matches
(list-matches xref-regexp content))
(define translation-map
(fold (match-lambda*
(((msgid . str) result)
(vhash-cons msgid str result)))
vlist-null
translations))
(define translated
;; Iterate over MATCHES and replace cross-references with their
;; translation found in TRANSLATION-MAP. (We can't use
;; 'substitute*' because matches can span multiple lines.)
(let loop ((matches matches)
(offset 0)
(result '()))
(match matches
(()
(string-concatenate-reverse
(cons (string-drop content offset) result)))
((head . tail)
(let ((prefix (match:substring head 1))
(ref (canonicalize-whitespace (match:substring head 2))))
(define translated
(string-append "@" (or prefix "")
"ref{"
(match (vhash-assoc ref translation-map)
(#f ref)
((_ . str) str))))
(loop tail
(match:end head)
(append (list translated
(string-take
(string-drop content offset)
(- (match:start head) offset)))
result)))))))
(format (current-error-port)
"translated ~a cross-references in '~a'~%"
(length matches) texi)
(call-with-output-file texi
(lambda (port)
(display translated port))))

@ -316,81 +316,23 @@ the result to OUTPUT."
chr))
str))
(define xref-regexp
;; Texinfo cross-reference regexp.
(make-regexp "@(px|x)?ref\\{([^,}]+)"))
(define (translate-cross-references texi translations)
;; Translate the cross-references that appear in TEXI, a Texinfo
;; file, using the msgid/msgstr pairs from TRANSLATIONS.
(define content
(call-with-input-file texi get-string-all))
(define matches
(list-matches xref-regexp content))
(define translation-map
(fold (match-lambda*
(((msgid . str) result)
(vhash-cons msgid str result)))
vlist-null
translations))
(define translated
;; Iterate over MATCHES and replace cross-references with their
;; translation found in TRANSLATION-MAP. (We can't use
;; 'substitute*' because matches can span multiple lines.)
(let loop ((matches matches)
(offset 0)
(result '()))
(match matches
(()
(string-concatenate-reverse
(cons (string-drop content offset) result)))
((head . tail)
(let ((prefix (match:substring head 1))
(ref (canonicalize-whitespace (match:substring head 2))))
(define translated
(string-append "@" (or prefix "")
"ref{"
(match (vhash-assoc ref translation-map)
(#f ref)
((_ . str) str))))
(loop tail
(match:end head)
(append (list translated
(string-take
(string-drop content offset)
(- (match:start head) offset)))
result)))))))
(format (current-error-port)
"translated ~a cross-references in '~a'~%"
(length matches) texi)
(call-with-output-file texi
(lambda (port)
(display translated port))))
(define* (translate-texi prefix po lang
#:key (extras '()))
"Translate the manual for one language LANG using the PO file.
PREFIX must be the prefix of the manual, 'guix' or 'guix-cookbook'. EXTRAS is
a list of extra files, such as '(\"contributing\")."
(let ((translations (call-with-input-file po read-po-file)))
(for-each (lambda (file)
(translate-tmp-texi po (string-append file ".texi")
(string-append file "." lang
".texi.tmp")))
(cons prefix extras))
(for-each (lambda (file)
(translate-tmp-texi po (string-append file ".texi")
(string-append file "." lang
".texi.tmp")))
(cons prefix extras))
(for-each (lambda (file)
(let* ((texi (string-append file "." lang ".texi"))
(tmp (string-append texi ".tmp")))
(copy-file tmp texi)
(translate-cross-references texi
translations)))
(cons prefix extras))))
(for-each (lambda (file)
(let* ((texi (string-append file "." lang ".texi"))
(tmp (string-append texi ".tmp")))
(copy-file tmp texi)
(translate-cross-references texi po)))
(cons prefix extras)))
(define (available-translations directory domain)
;; Return the list of available translations under DIRECTORY for