summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/ocaml.scm22
-rw-r--r--guix/build/go-build-system.scm4
-rw-r--r--guix/build/po.scm69
-rw-r--r--guix/scripts/system.scm2
-rw-r--r--guix/self.scm133
-rw-r--r--guix/store/deduplication.scm4
6 files changed, 206 insertions, 28 deletions
diff --git a/guix/build-system/ocaml.scm b/guix/build-system/ocaml.scm
index 07c69fac76..cbd33d9a89 100644
--- a/guix/build-system/ocaml.scm
+++ b/guix/build-system/ocaml.scm
@@ -28,9 +28,7 @@
#:use-module (srfi srfi-1)
#:export (%ocaml-build-system-modules
package-with-ocaml4.01
- package-with-ocaml4.02
strip-ocaml4.01-variant
- strip-ocaml4.02-variant
default-findlib
default-ocaml
lower
@@ -94,14 +92,6 @@
(let ((module (resolve-interface '(gnu packages ocaml))))
(module-ref module 'ocaml4.01-findlib)))
-(define (default-ocaml4.02)
- (let ((ocaml (resolve-interface '(gnu packages ocaml))))
- (module-ref ocaml 'ocaml-4.02)))
-
-(define (default-ocaml4.02-findlib)
- (let ((module (resolve-interface '(gnu packages ocaml))))
- (module-ref module 'ocaml4.02-findlib)))
-
(define* (package-with-explicit-ocaml ocaml findlib old-prefix new-prefix
#:key variant-property)
"Return a procedure of one argument, P. The procedure creates a package
@@ -161,24 +151,12 @@ pre-defined variants."
"ocaml-" "ocaml4.01-"
#:variant-property 'ocaml4.01-variant))
-(define package-with-ocaml4.02
- (package-with-explicit-ocaml (delay (default-ocaml4.02))
- (delay (default-ocaml4.02-findlib))
- "ocaml-" "ocaml4.02-"
- #:variant-property 'ocaml4.02-variant))
-
(define (strip-ocaml4.01-variant p)
"Remove the 'ocaml4.01-variant' property from P."
(package
(inherit p)
(properties (alist-delete 'ocaml4.01-variant (package-properties p)))))
-(define (strip-ocaml4.02-variant p)
- "Remove the 'ocaml4.02-variant' property from P."
- (package
- (inherit p)
- (properties (alist-delete 'ocaml4.02-variant (package-properties p)))))
-
(define* (lower name
#:key source inputs native-inputs outputs system target
(ocaml (default-ocaml))
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 1a716cea77..282df19f24 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -42,7 +42,7 @@
;; structure called a 'workspace' [1]. This workspace can be found by Go via
;; the GOPATH environment variable. Typically, all Go source code and compiled
;; objects are kept in a single workspace, but GOPATH may be a list of
-;; directories [2]. In this go-build-system we create a filesystem union of
+;; directories [2]. In this go-build-system we create a file system union of
;; the Go-language dependencies. Previously, we made GOPATH a list of store
;; directories, but stopped because Go programs started keeping references to
;; these directories in Go 1.11:
@@ -127,7 +127,7 @@
;; Code:
(define* (setup-go-environment #:key inputs outputs #:allow-other-keys)
- "Prepare a Go build environment for INPUTS and OUTPUTS. Build a filesystem
+ "Prepare a Go build environment for INPUTS and OUTPUTS. Build a file system
union of INPUTS. Export GOPATH, which helps the compiler find the source code
of the package being built and its dependencies, and GOBIN, which determines
where executables (\"commands\") are installed to. This phase is sometimes used
diff --git a/guix/build/po.scm b/guix/build/po.scm
new file mode 100644
index 0000000000..47ff67541c
--- /dev/null
+++ b/guix/build/po.scm
@@ -0,0 +1,69 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build po)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 peg)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 textual-ports)
+ #:export (read-po-file))
+
+;; A small parser for po files
+(define-peg-pattern po-file body (* (or comment entry whitespace)))
+(define-peg-pattern whitespace body (or " " "\t" "\n"))
+(define-peg-pattern comment-chr body (range #\space #\頋))
+(define-peg-pattern comment none (and "#" (* comment-chr) "\n"))
+(define-peg-pattern entry all
+ (and (ignore (* whitespace)) (ignore "msgid ") msgid
+ (ignore (* whitespace)) (ignore "msgstr ") msgstr))
+(define-peg-pattern escape body (or "\\\\" "\\\"" "\\n"))
+(define-peg-pattern str-chr body (or " " "!" (and (ignore "\\") "\"")
+ "\\n" (and (ignore "\\") "\\")
+ (range #\# #\頋)))
+(define-peg-pattern msgid all content)
+(define-peg-pattern msgstr all content)
+(define-peg-pattern content body
+ (and (ignore "\"") (* str-chr) (ignore "\"")
+ (? (and (ignore (* whitespace)) content))))
+
+(define (parse-tree->assoc parse-tree)
+ "Converts a po PARSE-TREE to an association list."
+ (define regex (make-regexp "\\\\n"))
+ (match parse-tree
+ ('() '())
+ ((entry parse-tree ...)
+ (match entry
+ ((? string? entry)
+ (parse-tree->assoc parse-tree))
+ ;; empty msgid
+ (('entry ('msgid ('msgstr msgstr)))
+ (parse-tree->assoc parse-tree))
+ ;; empty msgstr
+ (('entry ('msgid msgid) 'msgstr)
+ (parse-tree->assoc parse-tree))
+ (('entry ('msgid msgid) ('msgstr msgstr))
+ (acons (regexp-substitute/global #f regex msgid 'pre "\n" 'post)
+ (regexp-substitute/global #f regex msgstr 'pre "\n" 'post)
+ (parse-tree->assoc parse-tree)))))))
+
+(define (read-po-file port)
+ "Read a .po file from PORT and return an alist of msgid and msgstr."
+ (let ((tree (peg:tree (match-pattern
+ po-file
+ (get-string-all port)))))
+ (parse-tree->assoc tree)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 78aa6cf644..3c3d6cbd5f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -855,7 +855,7 @@ static checks."
(bootloader-configuration-bootloader (operating-system-bootloader os)))
(define bootcfg
- (and (not (eq? 'container action))
+ (and (memq action '(init reconfigure))
(operating-system-bootcfg os menu-entries)))
(define bootloader-script
diff --git a/guix/self.scm b/guix/self.scm
index de921e6d9c..68b87051e9 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -60,6 +60,8 @@
("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
@@ -253,8 +255,134 @@ 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 po4a
+ (specification->package "po4a"))
+
+ (define gettext
+ (specification->package "gettext"))
+
(define texinfo
(module-ref (resolve-interface '(gnu packages texinfo))
'texinfo))
@@ -327,6 +455,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 +480,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"
@@ -578,6 +708,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")))
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 8ca16a4cd8..d42c40932c 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -79,8 +79,8 @@ unused by the time you create anything with that name, but a good shot."
(define* (get-temp-link target #:optional (link-prefix (dirname target)))
"Like mkstemp!, but instead of creating a new file and giving you the name,
it creates a new hardlink to TARGET and gives you the name. Since
-cross-filesystem hardlinks don't work, the temp link must be created on the
-same filesystem - where in that filesystem it is can be controlled by
+cross-file-system hardlinks don't work, the temp link must be created on the
+same file system - where in that file system it is can be controlled by
LINK-PREFIX."
(let try ((tempname (tempname-in link-prefix)))
(catch 'system-error
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-20 03:18:36 +0000