diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-05-13 23:28:32 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-05-13 23:46:08 +0200 |
commit | 1be065c4784805e7a7b4c3f08970d8e4043b0a60 (patch) | |
tree | f8cdf148573535070d5c34cb5523a5ab08f4969d | |
parent | b33454ae0b488e79faafef75a06090be6b2ac6a2 (diff) | |
download | guix-1be065c4784805e7a7b4c3f08970d8e4043b0a60.tar.gz |
locale: Add 'glibc-supported-locales'.
* gnu/system/locale.scm (glibc-supported-locales): New procedure.
-rw-r--r-- | gnu/system/locale.scm | 72 |
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 |