~ruther/guix-local

0623138ffa5b066afc25547ffdeb97753cb0ee9a — Julien Lepiller 5 years ago d1b3754
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.
5 files changed, 165 insertions(+), 101 deletions(-)

M Makefile.am
A build-aux/convert-xref.scm
M doc/local.mk
M guix/build/po.scm
M guix/self.scm
M Makefile.am => Makefile.am +10 -2
@@ 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


A build-aux/convert-xref.scm => build-aux/convert-xref.scm +26 -0
@@ 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)))

M doc/local.mk => doc/local.mk +7 -22
@@ 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" "$@"

M guix/build/po.scm => guix/build/po.scm +110 -7
@@ 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)))
       (('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 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))))

M guix/self.scm => guix/self.scm +12 -70
@@ 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)
                          (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)
                        (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 po)))
                      (cons prefix extras)))

          (define (available-translations directory domain)
            ;; Return the list of available translations under DIRECTORY for