#:use-module (guix packages)
#:use-module (guix sets)
#:use-module (guix modules)
+ #:use-module ((guix utils) #:select (version-major+minor))
#:use-module ((guix build utils) #:select (find-files))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
(let ((ref (lambda (module variable)
(module-ref (resolve-interface module) variable))))
(match-lambda
- ("guile" (ref '(gnu packages guile) 'guile-3.0))
- ("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) 'guile3.0-gnutls))
- ("zlib" (ref '(gnu packages compression) 'zlib))
- ("lzlib" (ref '(gnu packages compression) 'lzlib))
+ ("gnutls" (ref '(gnu packages tls) '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))
+ ("gcc-toolchain" (ref '(gnu packages commencement) 'gcc-toolchain))
(_ #f)))) ;no such package
\f
;; 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 name build))
+(define (quiet-guile guile)
+ "Return a wrapper that does the same as the 'guile' executable of GUILE,
+except that it does not complain about locales and falls back to 'en_US.utf8'
+instead of 'C'."
+ (define gcc
+ (specification->package "gcc-toolchain"))
+
+ (define source
+ (search-path %load-path
+ "gnu/packages/aux-files/guile-launcher.c"))
+
+ (define effective
+ (version-major+minor (package-version guile)))
+
+ (define build
+ ;; XXX: Reuse <c-compiler> from (guix scripts pack) instead?
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-26))
+
+ (mkdir-p (string-append #$output "/bin"))
+
+ (setenv "PATH" #$(file-append gcc "/bin"))
+ (setenv "C_INCLUDE_PATH"
+ (string-join
+ (map (cut string-append <> "/include")
+ '#$(match (bag-transitive-build-inputs
+ (package->bag guile))
+ (((labels packages . _) ...)
+ (filter package? packages))))
+ ":"))
+ (setenv "LIBRARY_PATH" #$(file-append gcc "/lib"))
+
+ (invoke "gcc" #$(local-file source) "-Wall" "-g0" "-O2"
+ "-I" #$(file-append guile "/include/guile/" effective)
+ "-L" #$(file-append guile "/lib")
+ #$(string-append "-lguile-" effective)
+ "-o" (string-append #$output "/bin/guile")))))
+
+ (computed-file "guile-wrapper" build))
+
(define* (guix-command modules
#:key source (dependencies '())
guile (guile-version (effective-version)))
;; XXX: It would be more convenient to change it to:
;; (exit (apply guix-main (command-line)))
(apply guix-main (command-line))))
- #:guile guile))
+
+ ;; Use a 'guile' variant that doesn't complain about locales.
+ #:guile (quiet-guile guile)))
(define (miscellaneous-files source)
"Return data files taken from SOURCE."
,(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
HCoop / jackhill / guix / guix.git / blobdiff