aboutsummaryrefslogtreecommitdiff
path: root/gnu/build/locale.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-06 13:36:51 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-07 21:50:18 +0200
commit15ec93a7832ae7dde747ccd9bb2bb2776be9f199 (patch)
treec6b97d333950ec8ad734624244586cb60ca7e47d /gnu/build/locale.scm
parentbc48088b14a4513044f87ce656db6945311c40d6 (diff)
downloadpatches-15ec93a7832ae7dde747ccd9bb2bb2776be9f199.tar
patches-15ec93a7832ae7dde747ccd9bb2bb2776be9f199.tar.gz
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'.
Diffstat (limited to 'gnu/build/locale.scm')
-rw-r--r--gnu/build/locale.scm86
1 files changed, 86 insertions, 0 deletions
diff --git a/gnu/build/locale.scm b/gnu/build/locale.scm
new file mode 100644
index 0000000000..c75a2e9dc5
--- /dev/null
+++ b/gnu/build/locale.scm
@@ -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)))