new file mode 100644
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (gnu build locale)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:export (build-locale
+ normalize-codeset
+ read-supported-locales))
+
+(define locale-rx
+ ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
+ (make-regexp
+ "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
+
+(define (read-supported-locales port)
+ "Read the 'localedata/SUPPORTED' file from PORT. That file is actually a
+makefile snippet, with one locale per line, and a header that can be
+discarded."
+ (let loop ((locales '()))
+ (define line
+ (read-line port))
+
+ (cond ((eof-object? line)
+ (reverse locales))
+ ((string-prefix? "#" (string-trim line)) ;comment
+ (loop locales))
+ ((string-contains line "=") ;makefile variable assignment
+ (loop locales))
+ (else
+ (match (regexp-exec locale-rx line)
+ (#f
+ (loop locales))
+ (m
+ (loop (alist-cons (match:substring m 1)
+ (match:substring m 2)
+ locales))))))))
+
+(define (normalize-codeset codeset)
+ "Compute the \"normalized\" variant of CODESET."
+ ;; info "(libc) Using gettextized software", for the algorithm used to
+ ;; compute the normalized codeset.
+ (letrec-syntax ((-> (syntax-rules ()
+ ((_ proc value)
+ (proc value))
+ ((_ proc rest ...)
+ (proc (-> rest ...))))))
+ (-> (lambda (str)
+ (if (string-every char-set:digit str)
+ (string-append "iso" str)
+ str))
+ string-downcase
+ (lambda (str)
+ (string-filter char-set:letter+digit str))
+ codeset)))
+
+(define* (build-locale locale
+ #:key
+ (localedef "localedef")
+ (directory ".")
+ (codeset "UTF-8")
+ (name (string-append locale "." codeset)))
+ "Compute locale data for LOCALE and CODESET--e.g., \"en_US\" and
+\"UTF-8\"--with LOCALEDEF, and store it in DIRECTORY under NAME."
+ (format #t "building locale '~a'...~%" name)
+ (invoke localedef "--no-archive" "--prefix" directory
+ "-i" locale "-f" codeset
+ (string-append directory "/" name)))
@@ -19,6 +19,7 @@
(define-module (gnu installer locale)
#:use-module (gnu installer utils)
+ #:use-module ((gnu build locale) #:select (normalize-codeset))
#:use-module (guix records)
#:use-module (json)
#:use-module (srfi srfi-1)
@@ -71,24 +72,6 @@ optionally, CODESET."
(codeset . ,(or codeset (match:substring matches 5)))
(modifier . ,(match:substring matches 7)))))
-(define (normalize-codeset codeset)
- "Compute the \"normalized\" variant of CODESET."
- ;; info "(libc) Using gettextized software", for the algorithm used to
- ;; compute the normalized codeset.
- (letrec-syntax ((-> (syntax-rules ()
- ((_ proc value)
- (proc value))
- ((_ proc rest ...)
- (proc (-> rest ...))))))
- (-> (lambda (str)
- (if (string-every char-set:digit str)
- (string-append "iso" str)
- str))
- string-downcase
- (lambda (str)
- (string-filter char-set:letter+digit str))
- codeset)))
-
(define (locale->locale-string locale)
"Reverse operation of locale-string->locale."
(let ((language (locale-language locale))
@@ -637,6 +637,7 @@ dist_installer_DATA = \
# Modules that do not need to be compiled.
MODULES_NOT_COMPILED += \
+ %D%/build/locale.scm \
%D%/build/shepherd.scm \
%D%/build/svg.scm
@@ -85,20 +85,6 @@ or #f on failure."
(_
#f)))
-(define* (localedef-command locale
- #:key (libc (canonical-package glibc)))
- "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
- #~(begin
- (format #t "building locale '~a'...~%"
- #$(locale-definition-name locale))
- (zero? (system* (string-append #+libc "/bin/localedef")
- "--no-archive" "--prefix" #$output
- "-i" #$(locale-definition-source locale)
- "-f" #$(locale-definition-charset locale)
- (string-append #$output "/" #$(version-major+minor
- (package-version libc))
- "/" #$(locale-definition-name locale))))))
-
(define* (single-locale-directory locales
#:key (libc (canonical-package glibc)))
"Return a directory containing all of LOCALES for LIBC compiled.
@@ -110,17 +96,29 @@ of LIBC."
(version-major+minor (package-version libc)))
(define build
- #~(begin
- (mkdir #$output)
+ (with-imported-modules (source-module-closure
+ '((gnu build locale)))
+ #~(begin
+ (use-modules (gnu build locale))
- (mkdir (string-append #$output "/" #$version))
+ (mkdir #$output)
+ (mkdir (string-append #$output "/" #$version))
- ;; 'localedef' executes 'gzip' to access compressed locale sources.
- (setenv "PATH" (string-append #$gzip "/bin"))
+ ;; 'localedef' executes 'gzip' to access compressed locale sources.
+ (setenv "PATH"
+ (string-append #$gzip "/bin:" #$libc "/bin"))
- (exit
- (and #$@(map (cut localedef-command <> #:libc libc)
- locales)))))
+ (setvbuf (current-output-port) 'line)
+ (setvbuf (current-error-port) 'line)
+ (for-each (lambda (locale codeset name)
+ (build-locale locale
+ #:codeset codeset
+ #:name name
+ #:directory
+ (string-append #$output "/" #$version)))
+ '#$(map locale-definition-source locales)
+ '#$(map locale-definition-charset locales)
+ '#$(map locale-definition-name locales)))))
(computed-file (string-append "locale-" version) build))
@@ -216,45 +214,16 @@ pairs such as (\"oc_FR.UTF-8\" . \"UTF-8\"). Each pair corresponds to a
locale supported by GLIBC."
(define build
(with-imported-modules (source-module-closure
- '((guix build gnu-build-system)))
+ '((guix build gnu-build-system)
+ (gnu build locale)))
#~(begin
(use-modules (guix build gnu-build-system)
- (srfi srfi-1)
- (ice-9 rdelim)
- (ice-9 match)
- (ice-9 regex)
+ (gnu build locale)
(ice-9 pretty-print))
(define unpack
(assq-ref %standard-phases 'unpack))
- (define locale-rx
- ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
- (make-regexp
- "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
-
- (define (read-supported-locales port)
- ;; Read the 'localedata/SUPPORTED' file from PORT. That file is
- ;; actually a makefile snippet, with one locale per line, and a
- ;; header that can be discarded.
- (let loop ((locales '()))
- (define line
- (read-line port))
-
- (cond ((eof-object? line)
- (reverse locales))
- ((string-prefix? "#" (string-trim line)) ;comment
- (loop locales))
- ((string-contains line "=") ;makefile variable assignment
- (loop locales))
- (else
- (match (regexp-exec locale-rx line)
- (#f
- (loop locales))
- (m
- (loop (alist-cons (match:substring m 1)
- (match:substring m 2)
- locales))))))))
(setenv "PATH"
(string-append #+(file-append tar "/bin") ":"