;;; 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-3))
+ ("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))
- ("lzlib" (ref '(gnu packages compression) 'lzlib))
+ ("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))
;; 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.
#~(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)
+ (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"))
(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))
+ (n-par-for-each (parallel-job-count)
+ (match-lambda
+ ((language . po)
+ (translate-texi "guix" po language
+ #:extras '("contributing"))))
+ (available-translations "." "guix-manual"))
- (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$"))
+ (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)
- (copy-file file (string-append #$output "/" file)))
- (append
- (find-files "." "contributing\\..*\\.texi$")
- (find-files "." "guix\\..*\\.texi$"))))))
+ (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 build
(with-imported-modules '((guix build utils))
#~(begin
- (use-modules (guix build utils))
+ (use-modules (guix build utils)
+ (ice-9 match))
(mkdir #$output)
#+(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}(_[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/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
(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"))
(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)))
'()
#:extra-modules
`(((guix config)
- => ,(make-config.scm #:zlib zlib
- #:lzlib lzlib
- #:gzip gzip
+ => ,(make-config.scm #:gzip gzip
#:bzip2 bzip2
#:xz xz
#:package-name
(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")
%state-directory
%store-database-directory
%config-directory
- %libz
- %liblz
%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")))
-
- (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
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