nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
master
Ludovic Courtès 2019-06-06 13:36:51 +02:00
parent bc48088b14
commit 15ec93a783
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 111 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
gnu/build/locale.scm Normal file
View File

@ -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
gnu/installer/locale.scm
View File

@ -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))

1
gnu/local.mk
View File

@ -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

77
gnu/system/locale.scm
View File

@ -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") ":"