diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index c83775d8ee..3fc43b04da 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -53,6 +53,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) @@ -62,6 +64,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (glibc + %default-utf8-locales + make-glibc-utf8-locales libiconv-if-needed)) ;;; Commentary: @@ -1106,7 +1110,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)) @@ -1145,10 +1154,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 @@ -1169,6 +1185,40 @@ test environments.") (package (inherit (make-glibc-utf8-locales glibc-2.29)) (name "glibc-utf8-locales-2.29"))) +(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")