diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index e8150708c0..98b413da13 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2014, 2019 Andreas Enge ;;; Copyright © 2012 Nikita Karetnikov ;;; Copyright © 2014, 2015, 2016, 2018 Mark H Weaver @@ -52,6 +52,8 @@ #:use-module (gnu packages python) #:use-module (gnu packages gettext) #:use-module (guix utils) + #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) @@ -61,6 +63,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (glibc + %default-utf8-locales + make-glibc-utf8-locales libiconv-if-needed)) ;;; Commentary: @@ -1076,7 +1080,12 @@ to the @code{share/locale} sub-directory of this package.") ,(version-major+minor (package-version glibc))))))))))) -(define-public (make-glibc-utf8-locales glibc) +(define %default-utf8-locales + '("de_DE" "el_GR" "en_US" "fr_FR" "tr_TR")) + +(define* (make-glibc-utf8-locales glibc #:optional + (locales %default-utf8-locales) + (locale-file #f)) (package (name "glibc-utf8-locales") (version (package-version glibc)) @@ -1115,10 +1124,17 @@ to the @code{share/locale} sub-directory of this package.") ;; These are the locales commonly used for ;; tests---e.g., in Guile's i18n tests. - '("de_DE" "el_GR" "en_US" "fr_FR" "tr_TR")) + ,(if locale-file + `(call-with-input-file + (assoc-ref %build-inputs "locale-file") + read) + `',locales)) #t)))) (native-inputs `(("glibc" ,glibc) - ("gzip" ,gzip))) + ("gzip" ,gzip) + ,@(if locale-file + `(("locale-file" ,locale-file)) + '()))) (synopsis "Small sample of UTF-8 locales") (description "This package provides a small sample of UTF-8 locales mostly useful in @@ -1145,6 +1161,40 @@ test environments.") (define-public glibc-locales-2.27 (deprecated-package "glibc-locales-2.27" glibc-locales-2.28)) +(define (glibc-supported-locales libc) + ((module-ref (resolve-interface '(gnu system locale)) ;FIXME: hack + 'glibc-supported-locales) + libc)) + +(define* (make-glibc-utf8-locales/full #:optional (glibc glibc)) + (define utf8-locales + (computed-file "glibc-supported-utf8-locales.scm" + #~(begin + (use-modules (srfi srfi-1) + (ice-9 match) + (ice-9 pretty-print)) + + (define locales + (call-with-input-file + #+(glibc-supported-locales glibc) + read)) + + (define utf8-locales + (filter-map (match-lambda + ((name . "UTF-8") + (if (string-suffix? ".UTF-8" name) + (string-drop-right name 6) + name)) + (_ #f)) + locales)) + + (call-with-output-file #$output + (lambda (port) + (pretty-print utf8-locales port)))))) + + (make-glibc-utf8-locales glibc #:locale-file utf8-locales)) + + (define-public which (package (name "which")