summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-05-13 23:28:32 +0200
committerLudovic Courtès <ludo@gnu.org>2019-05-13 23:46:08 +0200
commit1be065c4784805e7a7b4c3f08970d8e4043b0a60 (patch)
treef8cdf148573535070d5c34cb5523a5ab08f4969d /gnu/system
parentb33454ae0b488e79faafef75a06090be6b2ac6a2 (diff)
locale: Add 'glibc-supported-locales'.
* gnu/system/locale.scm (glibc-supported-locales): New procedure.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/locale.scm72
1 files changed, 70 insertions, 2 deletions
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 75417f6698..533a45e149 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -20,6 +20,7 @@
(define-module (gnu system locale)
#:use-module (guix gexp)
#:use-module (guix store)
+ #:use-module (guix modules)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix utils)
@@ -37,7 +38,9 @@
locale-directory
%default-locale-libcs
- %default-locale-definitions))
+ %default-locale-definitions
+
+ glibc-supported-locales))
;;; Commentary:
;;;
@@ -202,4 +205,69 @@ data format changes between libc versions."
"vi_VN"
"zh_CN"))))
+
+;;;
+;;; Locales supported by glibc.
+;;;
+
+(define* (glibc-supported-locales #:optional (glibc glibc))
+ "Return a file-like object that contains a list of locale name/encoding
+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)))
+ #~(begin
+ (use-modules (guix build gnu-build-system)
+ (srfi srfi-1)
+ (ice-9 rdelim)
+ (ice-9 match)
+ (ice-9 regex)
+ (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") ":"
+ #+(file-append xz "/bin") ":"
+ #+(file-append gzip "/bin")))
+ (unpack #:source #+(package-source glibc))
+
+ (let ((locales (call-with-input-file "localedata/SUPPORTED"
+ read-supported-locales)))
+ (call-with-output-file #$output
+ (lambda (port)
+ (pretty-print locales port)))))))
+
+ (computed-file "glibc-supported-locales.scm" build))
+
;;; locale.scm ends here