Merge remote-tracking branch 'signed/master' into core-updates

4 files changed, 132 insertions, 20 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index fd8fe69901..7c310e94f1 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -36,7 +36,7 @@
   #:use-module (srfi srfi-26)
   #:autoload   (ice-9 ftw) (scandir)
   #:autoload   (guix base16) (bytevector->base16-string)
-  #:autoload   (guix swh) (swh-download-directory)
+  #:autoload   (guix swh) (swh-download-directory %verify-swh-certificate?)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (open-socket-for-uri
@@ -646,6 +646,8 @@ and write the output to FILE."
                                                   #:verify-certificate?
                                                   verify-certificate?
                                                   #:timeout timeout)))
+              (format #t "Retrieving Disarchive spec from ~a ...~%"
+                      (uri->string uri))
               (let ((specification (read port)))
                 (close-port port)
                 specification))))
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 645d2fe680..4768ee8562 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -152,8 +152,10 @@ dependencies, so it should be self-contained."
 
   ;; Make sure we're building for the correct architecture and OS targets
   ;; that Guix targets.
-  (setenv "GOARCH" goarch)
-  (setenv "GOOS" goos)
+  (setenv "GOARCH" (or goarch
+                       (getenv "GOHOSTARCH")))
+  (setenv "GOOS" (or goos
+                     (getenv "GOHOSTOS")))
   (match goarch
     ("arm"
      (setenv "GOARM" "7"))
diff --git a/guix/build/minetest-build-system.scm b/guix/build/minetest-build-system.scm
index 477cc3d1d0..5f68686067 100644
--- a/guix/build/minetest-build-system.scm
+++ b/guix/build/minetest-build-system.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 exceptions)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module ((guix build copy-build-system) #:prefix copy:)
   #:export (%standard-phases
@@ -40,7 +41,7 @@
      ;; See <https://github.com/minetest/minetest/blob/master/doc/lua_api.txt>
      ;; for an incomple list of files that can be found in mods.
      #:include ("mod.conf" "modpack.conf" "settingtypes.txt" "depends.txt"
-                "description.txt")
+                "description.txt" "config.txt" "_config.txt")
      #:include-regexp (".lua$" ".png$" ".ogg$" ".obj$" ".b3d$" ".tr$"
                        ".mts$"))))
 
@@ -199,20 +200,24 @@ auth_backend = sqlite3
         (define (stop? line)
           (and (string? line)
                (string-contains line "ACTION[Server]: singleplayer [127.0.0.1] joins game.")))
-        (let loop ()
-          (match (read-line port)
-            ((? error? line)
-             (error "minetest raised an error: ~a" line))
-            ((? stop?)
+        (let loop ((has-errors? #f))
+          (match `(,(read-line port) ,has-errors?)
+            (((? error? line) _)
+             (display line)
+             (newline)
+             (loop #t))
+            (((? stop?) #f)
              (kill pid SIGINT)
              (close-port port)
              (waitpid pid))
-            ((? string? line)
+            (((? eof-object?) #f)
+             (error "minetest didn't start"))
+            (((or (? stop?) (? eof-object?)) #t)
+             (error "minetest raised an error"))
+            (((? string? line) has-error?)
              (display line)
              (newline)
-             (loop))
-            ((? eof-object?)
-             (error "minetest didn't start"))))))))
+             (loop has-error?))))))))
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
diff --git a/guix/build/po.scm b/guix/build/po.scm
index eb9690ad1a..7f88164cd8 100644
--- a/guix/build/po.scm
+++ b/guix/build/po.scm
@@ -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))))