gnu: r-qtl2: Move to (gnu packages cran).
[jackhill/guix/guix.git] / guix / self.scm
index a956804..02ef982 100644 (file)
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages guile) 'guile-3.0/libgc-7))
-      ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
+      ("guile-json" (ref '(gnu packages guile) 'guile-json-4))
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+      ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
+      ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'guile3.0-gnutls))
-      ("zlib"       (ref '(gnu packages compression) 'zlib))
-      ("lzlib"      (ref '(gnu packages compression) 'lzlib))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
@@ -213,7 +213,15 @@ record with the new file name."
      ;; itself.
      (local-file (string-append item "/" file)
                  #:recursive? recursive?))
-    ;; TODO: Add 'local-file?' case.
+    ((? local-file? base)
+     ;; Likewise, but with a <local-file>.
+     (if (local-file-recursive? base)
+         (local-file (string-append (local-file-absolute-file-name base)
+                                    "/" file)
+                     (basename file)
+                     #:recursive? recursive?
+                     #:select? (local-file-select? base))
+         (file-append base file)))
     (_
      ;; In this case, anything that refers to the result also depends on ITEM,
      ;; which isn't great.
@@ -282,24 +290,9 @@ DOMAIN, a gettext domain."
       #~(begin
           (use-modules (guix build utils) (guix build po)
                        (ice-9 match) (ice-9 regex) (ice-9 textual-ports)
+                       (ice-9 vlist) (ice-9 threads)
                        (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."
@@ -307,38 +300,69 @@ the result to OUTPUT."
               "-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 (canonicalize-whitespace str)
+            ;; Change whitespace (newlines, etc.) in STR to #\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 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 '()))
@@ -355,12 +379,9 @@ a list of extra files, such as '(\"contributing\")."
               (for-each (lambda (file)
                           (let* ((texi (string-append file "." lang ".texi"))
                                  (tmp  (string-append texi ".tmp")))
-                            (with-output-to-file texi
-                              (lambda ()
-                                (display
-                                 (translate-cross-references
-                                  (call-with-input-file tmp get-string-all)
-                                  translations))))))
+                            (copy-file tmp texi)
+                            (translate-cross-references texi
+                                                        translations)))
                         (cons prefix extras))))
 
           (define (available-translations directory domain)
@@ -377,16 +398,33 @@ a list of extra files, such as '(\"contributing\")."
                         (find-files directory
                                     "\\.[a-z]{2}(_[A-Z]{2})?\\.po$")))
 
-          (for-each (match-lambda
-                      ((language . po)
-                       (translate-texi "guix" po language
-                                       #:extras '("contributing"))))
-                    (available-translations "." "guix-manual"))
+          (mkdir #$output)
+          (copy-recursively #$documentation "."
+                            #:log (%make-void-port "w"))
 
-          (for-each (match-lambda
-                      ((language . po)
-                       (translate-texi "guix-cookbook" po language)))
-                    (available-translations "." "guix-cookbook"))
+          (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")
+
+          (n-par-for-each (parallel-job-count)
+                          (match-lambda
+                            ((language . po)
+                             (translate-texi "guix" po language
+                                             #:extras '("contributing"))))
+                          (available-translations "." "guix-manual"))
+
+          (n-par-for-each (parallel-job-count)
+                          (match-lambda
+                            ((language . po)
+                             (translate-texi "guix-cookbook" po language)))
+                          (available-translations "." "guix-cookbook"))
 
           (for-each (lambda (file)
                       (install-file file #$output))
@@ -609,13 +647,13 @@ load path."
                    ,(file-append* source "/etc/completion/zsh/_guix"))
                   ("share/fish/vendor_completions.d/guix.fish"
                    ,(file-append* source "/etc/completion/fish/guix.fish"))
-                  ("share/guix/berlin.guixsd.org.pub"
+                  ("share/guix/berlin.guix.gnu.org.pub"
                    ,(file-append* source
-                                  "/etc/substitutes/berlin.guixsd.org.pub"))
+                                  "/etc/substitutes/berlin.guix.gnu.org.pub"))
                   ("share/guix/ci.guix.gnu.org.pub"  ;alias
-                   ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub"))
+                   ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub"))
                   ("share/guix/ci.guix.info.pub"  ;alias
-                   ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub")))))
+                   ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub")))))
 
 (define* (whole-package name modules dependencies
                         #:key
@@ -689,8 +727,6 @@ Info manual."
                         (name (string-append "guix-" version))
                         (guile-version (effective-version))
                         (guile-for-build (default-guile))
-                        (zlib (specification->package "zlib"))
-                        (lzlib (specification->package "lzlib"))
                         (gzip (specification->package "gzip"))
                         (bzip2 (specification->package "bzip2"))
                         (xz (specification->package "xz"))
@@ -708,6 +744,12 @@ Info manual."
   (define guile-sqlite3
     (specification->package "guile-sqlite3"))
 
+  (define guile-zlib
+    (specification->package "guile-zlib"))
+
+  (define guile-lzlib
+    (specification->package "guile-lzlib"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
@@ -719,7 +761,7 @@ Info manual."
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
                        (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3))
+                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
@@ -846,9 +888,7 @@ Info manual."
                  '()
                  #:extra-modules
                  `(((guix config)
-                    => ,(make-config.scm #:zlib zlib
-                                         #:lzlib lzlib
-                                         #:gzip gzip
+                    => ,(make-config.scm #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
                                          #:package-name
@@ -945,7 +985,7 @@ Info manual."
                                       (variables rest ...))))))
     (variables %localstatedir %storedir %sysconfdir)))
 
-(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
@@ -966,8 +1006,6 @@ Info manual."
                                %state-directory
                                %store-database-directory
                                %config-directory
-                               %libz
-                               %liblz
                                %gzip
                                %bzip2
                                %xz))
@@ -1010,15 +1048,7 @@ Info manual."
                    (define %bzip2
                      #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                    (define %xz
-                     #+(and xz (file-append xz "/bin/xz")))
-
-                   (define %libz
-                     #+(and zlib
-                            (file-append zlib "/lib/libz")))
-
-                   (define %liblz
-                     #+(and lzlib
-                            (file-append lzlib "/lib/liblz"))))
+                     #+(and xz (file-append xz "/bin/xz"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are