Add (gnu build locale).
* gnu/build/locale.scm: New file. * gnu/local.mk (MODULES_NOT_COMPILED): Add it. * gnu/installer/locale.scm (normalize-codeset): Remove. * gnu/system/locale.scm (localedef-command): Remove. (single-locale-directory): Use (gnu build locale). (glibc-supported-locales)[build]: Likewise, and remove 'read-supported-locales'.
This commit is contained in:
parent
bc48088b14
commit
15ec93a783
|
@ -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)
|
(define-module (gnu installer locale)
|
||||||
#:use-module (gnu installer utils)
|
#:use-module (gnu installer utils)
|
||||||
|
#:use-module ((gnu build locale) #:select (normalize-codeset))
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (json)
|
#:use-module (json)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -71,24 +72,6 @@ optionally, CODESET."
|
||||||
(codeset . ,(or codeset (match:substring matches 5)))
|
(codeset . ,(or codeset (match:substring matches 5)))
|
||||||
(modifier . ,(match:substring matches 7)))))
|
(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)
|
(define (locale->locale-string locale)
|
||||||
"Reverse operation of locale-string->locale."
|
"Reverse operation of locale-string->locale."
|
||||||
(let ((language (locale-language locale))
|
(let ((language (locale-language locale))
|
||||||
|
|
|
@ -639,6 +639,7 @@ dist_installer_DATA = \
|
||||||
|
|
||||||
# Modules that do not need to be compiled.
|
# Modules that do not need to be compiled.
|
||||||
MODULES_NOT_COMPILED += \
|
MODULES_NOT_COMPILED += \
|
||||||
|
%D%/build/locale.scm \
|
||||||
%D%/build/shepherd.scm \
|
%D%/build/shepherd.scm \
|
||||||
%D%/build/svg.scm
|
%D%/build/svg.scm
|
||||||
|
|
||||||
|
|
|
@ -85,20 +85,6 @@ or #f on failure."
|
||||||
(_
|
(_
|
||||||
#f)))
|
#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
|
(define* (single-locale-directory locales
|
||||||
#:key (libc (canonical-package glibc)))
|
#:key (libc (canonical-package glibc)))
|
||||||
"Return a directory containing all of LOCALES for LIBC compiled.
|
"Return a directory containing all of LOCALES for LIBC compiled.
|
||||||
|
@ -110,17 +96,29 @@ of LIBC."
|
||||||
(version-major+minor (package-version libc)))
|
(version-major+minor (package-version libc)))
|
||||||
|
|
||||||
(define build
|
(define build
|
||||||
|
(with-imported-modules (source-module-closure
|
||||||
|
'((gnu build locale)))
|
||||||
#~(begin
|
#~(begin
|
||||||
(mkdir #$output)
|
(use-modules (gnu build locale))
|
||||||
|
|
||||||
|
(mkdir #$output)
|
||||||
(mkdir (string-append #$output "/" #$version))
|
(mkdir (string-append #$output "/" #$version))
|
||||||
|
|
||||||
;; 'localedef' executes 'gzip' to access compressed locale sources.
|
;; 'localedef' executes 'gzip' to access compressed locale sources.
|
||||||
(setenv "PATH" (string-append #$gzip "/bin"))
|
(setenv "PATH"
|
||||||
|
(string-append #$gzip "/bin:" #$libc "/bin"))
|
||||||
|
|
||||||
(exit
|
(setvbuf (current-output-port) 'line)
|
||||||
(and #$@(map (cut localedef-command <> #:libc libc)
|
(setvbuf (current-error-port) 'line)
|
||||||
locales)))))
|
(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))
|
(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."
|
locale supported by GLIBC."
|
||||||
(define build
|
(define build
|
||||||
(with-imported-modules (source-module-closure
|
(with-imported-modules (source-module-closure
|
||||||
'((guix build gnu-build-system)))
|
'((guix build gnu-build-system)
|
||||||
|
(gnu build locale)))
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (guix build gnu-build-system)
|
(use-modules (guix build gnu-build-system)
|
||||||
(srfi srfi-1)
|
(gnu build locale)
|
||||||
(ice-9 rdelim)
|
|
||||||
(ice-9 match)
|
|
||||||
(ice-9 regex)
|
|
||||||
(ice-9 pretty-print))
|
(ice-9 pretty-print))
|
||||||
|
|
||||||
(define unpack
|
(define unpack
|
||||||
(assq-ref %standard-phases '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"
|
(setenv "PATH"
|
||||||
(string-append #+(file-append tar "/bin") ":"
|
(string-append #+(file-append tar "/bin") ":"
|
||||||
|
|
Loading…
Reference in New Issue