mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
locale: Add 'glibc-supported-locales'.
* gnu/system/locale.scm (glibc-supported-locales): New procedure.
This commit is contained in:
parent
b33454ae0b
commit
1be065c478
1 changed files with 70 additions and 2 deletions
|
@ -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 @@ (define-module (gnu system locale)
|
|||
locale-directory
|
||||
|
||||
%default-locale-libcs
|
||||
%default-locale-definitions))
|
||||
%default-locale-definitions
|
||||
|
||||
glibc-supported-locales))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -202,4 +205,69 @@ (define %default-locale-definitions
|
|||
"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
|
||||
|
|
Loading…
Reference in a new issue