build-system/julia: Avoid module cycles.
[jackhill/guix/guix.git] / guix / self.scm
index bcf04a1..f03fe01 100644 (file)
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages commencement) 'guile-final))
-      ("guile-json" (ref '(gnu packages guile) 'guile-json))
+      ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
       ("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-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) '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))
+      ("po4a"       (ref '(gnu packages gettext) 'po4a))
+      ("gettext"       (ref '(gnu packages gettext) 'gettext-minimal))
       (_            #f))))                        ;no such package
 
 \f
@@ -253,6 +256,126 @@ DOMAIN, a gettext domain."
   (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 texinfo
@@ -327,6 +450,8 @@ DOMAIN, a gettext domain."
           ;; 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")
 
@@ -350,7 +475,7 @@ DOMAIN, a gettext domain."
                                                   (basename texi ".texi")
                                                   ".info")))
                     (cons "guix.texi"
-                          (find-files "." "^guix\\.[a-z]{2}\\.texi$")))
+                          (find-files "." "^guix\\.[a-z]{2}(_[A-Z]{2})?\\.texi$")))
 
           ;; Compress Info files.
           (setenv "PATH"
@@ -452,12 +577,11 @@ 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/hydra.gnu.org.pub"
-                   ,(file-append* source
-                                  "/etc/substitutes/hydra.gnu.org.pub"))
                   ("share/guix/berlin.guixsd.org.pub"
                    ,(file-append* source
                                   "/etc/substitutes/berlin.guixsd.org.pub"))
+                  ("share/guix/ci.guix.gnu.org.pub"  ;alias
+                   ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub"))
                   ("share/guix/ci.guix.info.pub"  ;alias
                    ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub")))))
 
@@ -477,7 +601,21 @@ Info manual."
   (define (wrap daemon)
     (program-file "guix-daemon"
                   #~(begin
+                      ;; Refer to the right 'guix' command for 'guix
+                      ;; substitute' & co.
                       (setenv "GUIX" #$command)
+
+                      ;; Honor the user's settings rather than those hardcoded
+                      ;; in the 'guix-daemon' package.
+                      (unless (getenv "GUIX_STATE_DIRECTORY")
+                        (setenv "GUIX_STATE_DIRECTORY"
+                                #$(string-append %localstatedir "/guix")))
+                      (unless (getenv "GUIX_CONFIGURATION_DIRECTORY")
+                        (setenv "GUIX_CONFIGURATION_DIRECTORY"
+                                #$(string-append %sysconfdir "/guix")))
+                      (unless (getenv "NIX_STORE_DIR")
+                        (setenv "NIX_STORE_DIR" #$%storedir))
+
                       (apply execl #$(file-append daemon "/bin/guix-daemon")
                              "guix-daemon" (cdr (command-line))))))
 
@@ -520,6 +658,7 @@ Info manual."
                         (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"))
@@ -578,6 +717,7 @@ Info manual."
                  ;; 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")))
 
@@ -627,8 +767,10 @@ Info manual."
     (scheme-node "guix-system"
                  `((gnu system)
                    (gnu services)
+                   ,@(scheme-modules* source "gnu/bootloader")
                    ,@(scheme-modules* source "gnu/system")
-                   ,@(scheme-modules* source "gnu/services"))
+                   ,@(scheme-modules* source "gnu/services")
+                   ,@(scheme-modules* source "gnu/machine"))
                  (list *core-package-modules* *package-modules*
                        *extra-modules* *core-modules*)
                  #:extensions dependencies
@@ -672,6 +814,7 @@ Info manual."
                  #:extra-modules
                  `(((guix config)
                     => ,(make-config.scm #:zlib zlib
+                                         #:lzlib lzlib
                                          #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
@@ -752,10 +895,6 @@ Info manual."
 ;;; Generating (guix config).
 ;;;
 
-(define %dependency-variables
-  ;; (guix config) variables corresponding to dependencies.
-  '(%libz %xz %gzip %bzip2))
-
 (define %persona-variables
   ;; (guix config) variables that define Guix's persona.
   '(%guix-package-name
@@ -771,13 +910,13 @@ Info manual."
                                ((_ variable rest ...)
                                 (cons `(variable . ,variable)
                                       (variables rest ...))))))
-    (variables %localstatedir %storedir %sysconfdir %system)))
+    (variables %localstatedir %storedir %sysconfdir)))
 
-(define* (make-config.scm #:key zlib gzip xz bzip2
+(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
-                          (home-page-url "https://gnu.org/s/guix"))
+                          (home-page-url "https://guix.gnu.org"))
 
   ;; Hack so that Geiser is not confused.
   (define defmod 'define-module)
@@ -789,15 +928,20 @@ Info manual."
                                %guix-version
                                %guix-bug-report-address
                                %guix-home-page-url
+                               %system
                                %store-directory
                                %state-directory
                                %store-database-directory
                                %config-directory
                                %libz
+                               %liblz
                                %gzip
                                %bzip2
                                %xz))
 
+                   (define %system
+                     #$(%current-system))
+
                    #$@(map (match-lambda
                              ((name . value)
                               #~(define-public #$name #$value)))
@@ -837,7 +981,11 @@ Info manual."
 
                    (define %libz
                      #+(and zlib
-                            (file-append zlib "/lib/libz"))))
+                            (file-append zlib "/lib/libz")))
+
+                   (define %liblz
+                     #+(and lzlib
+                            (file-append lzlib "/lib/liblz"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are