;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix sets)
#:use-module (guix modules)
#:use-module ((guix build utils) #:select (find-files))
- #:use-module ((guix build compile) #:select (%lightweight-optimizations))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-35)
(let ((ref (lambda (module variable)
(module-ref (resolve-interface module) variable))))
(match-lambda
- ("guile" (ref '(gnu packages commencement) 'guile-final))
- ("guile-json" (ref '(gnu packages guile) 'guile-json))
+ ("guile" (ref '(gnu packages guile) 'guile-3.0/libgc-7))
+ ("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) 'gnutls))
- ("zlib" (ref '(gnu packages compression) 'zlib))
+ ("gnutls" (ref '(gnu packages tls) 'guile3.0-gnutls))
("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
(symlink #$(node-compiled node) object))))
(computed-file (string-append (node-name node) "-modules")
- build))
+ build
+ #:options '(#:local-build? #t
+
+ ;; "Building" it locally is faster.
+ #:substitutable? #f)))
(define (node-fold proc init nodes)
(let loop ((nodes nodes)
;; 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.
(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)
+ (ice-9 vlist) (ice-9 threads)
+ (srfi srfi-1))
+
+ (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 (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 '()))
+ "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))))
+
+ (define (available-translations directory domain)
+ ;; Return the list of available translations under DIRECTORY for
+ ;; DOMAIN, a gettext domain such as "guix-manual". The result is
+ ;; a list of language/PO file pairs.
+ (filter-map (lambda (po)
+ (let ((base (basename po)))
+ (and (string-prefix? (string-append domain ".")
+ base)
+ (match (string-split base #\.)
+ ((_ ... lang "po")
+ (cons lang po))))))
+ (find-files directory
+ "\\.[a-z]{2}(_[A-Z]{2})?\\.po$")))
+
+ (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")
+
+ (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))
+ (append
+ (find-files "." "contributing\\..*\\.texi$")
+ (find-files "." "guix\\..*\\.texi$")
+ (find-files "." "guix-cookbook\\..*\\.texi$"))))))
+
+ (computed-file "guix-translated-texinfo" build))
+
(define (info-manual source)
"Return the Info manual built from SOURCE."
(define texinfo
(define build
(with-imported-modules '((guix build utils))
#~(begin
- (use-modules (guix build utils))
+ (use-modules (guix build utils)
+ (ice-9 match))
(mkdir #$output)
;; 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")
#+(file-append glibc-utf8-locales "/lib/locale"))
(for-each (lambda (texi)
- (unless (string=? "guix.texi" texi)
- ;; Create 'version-LL.texi'.
- (let* ((base (basename texi ".texi"))
- (dot (string-index base #\.))
- (tag (string-drop base (+ 1 dot))))
- (symlink "version.texi"
- (string-append "version-" tag ".texi"))))
+ (match (string-split (basename texi) #\.)
+ (("guix" language "texi")
+ ;; Create 'version-LL.texi'.
+ (symlink "version.texi"
+ (string-append "version-" language
+ ".texi")))
+ (_ #f))
(invoke #+(file-append texinfo "/bin/makeinfo")
texi "-I" #$documentation
(basename texi ".texi")
".info")))
(cons "guix.texi"
- (find-files "." "^guix\\.[a-z]{2}\\.texi$")))
+ (append (find-files "."
+ "^guix\\.[a-z]{2}(_[A-Z]{2})?\\.texi$")
+ (find-files "."
+ "^guix-cookbook.*\\.texi$"))))
;; Compress Info files.
(setenv "PATH"
(computed-file "guix-manual" build))
+(define-syntax-rule (prevent-inlining! identifier ...)
+ (begin (set! identifier identifier) ...))
+
+;; XXX: These procedures are actually used by 'doc/build.scm'. Protect them
+;; from inlining on Guile 3.
+(prevent-inlining! file-append* translate-texi-manuals info-manual)
+
(define* (guile-module-union things #:key (name "guix-module-union"))
"Return the union of the subset of THINGS (packages, computed files, etc.)
that provide Guile modules."
,(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"
+ ("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.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
(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))))))
(name (string-append "guix-" version))
(guile-version (effective-version))
(guile-for-build (default-guile))
- (zlib (specification->package "zlib"))
(gzip (specification->package "gzip"))
(bzip2 (specification->package "bzip2"))
(xz (specification->package "xz"))
(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"))
(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)))
;; 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")))
(filter-map (match-lambda
(('guix 'scripts _ ..1) #f)
(('guix 'man-db) #f)
+ (('guix 'tests _ ...) #f)
(name name))
(scheme-modules* source "guix"))
(list *core-modules*)
(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
'()
#:extra-modules
`(((guix config)
- => ,(make-config.scm #:zlib zlib
- #:gzip gzip
+ => ,(make-config.scm #:gzip gzip
#:bzip2 bzip2
#:xz xz
#:package-name
;;; 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
(variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir)))
-(define* (make-config.scm #:key zlib 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")
- (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)
%state-directory
%store-database-directory
%config-directory
- %libz
%gzip
%bzip2
%xz))
(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"))))
+ #+(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
version))
(define guile
- ;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2
- ;; unconditionally.
- (default-guile))
+ ;; When PULL-VERSION >= 1, produce a self-contained Guix and use the
+ ;; current Guile unconditionally.
+ (specification->package "guile"))
(when (and (< pull-version 1)
(not (string=? (package-version guile) guile-version)))
(shorten version))
#:pull-version pull-version
#:guile-version (if (>= pull-version 1)
- "2.2" guile-version)
+ "3.0" guile-version)
#:guile-for-build guile)))
(if guix
(lower-object guix)
HCoop / jackhill / guix / guix.git / blobdiff