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:
Ludovic Courtès
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)
|
||||
#: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))
|
||||
|
|
|
|||
|
|
@ -639,6 +639,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") ":"
|
||||
|
|
|
|||
Loading…
Reference in New Issue