diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/system.scm | 29 | ||||
| -rw-r--r-- | gnu/system/locale.scm | 32 |
2 files changed, 52 insertions, 9 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 9540324df0..b9d717d5ed 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -669,18 +669,31 @@ hardware-related operations as necessary when booting a Linux container." #:mapped-devices mapped-devices))) (return #~(string-append #$initrd "/initrd")))) +(define (locale-name->definition* name) + "Variant of 'locale-name->definition' that raises an error upon failure." + (match (locale-name->definition name) + (#f + (raise (condition + (&message + (message (format #f (_ "~a: invalid locale name") name)))))) + (def def))) + (define (operating-system-locale-directory os) "Return the directory containing the locales compiled for the definitions listed in OS. The C library expects to find it under /run/current-system/locale." - ;; While we're at it, check whether the locale of OS is defined. - (unless (member (operating-system-locale os) - (map locale-definition-name - (operating-system-locale-definitions os))) - (raise (condition - (&message (message "system locale lacks a definition"))))) - - (locale-directory (operating-system-locale-definitions os) + (define name + (operating-system-locale os)) + + (define definitions + ;; While we're at it, check whether NAME is defined and add it if needed. + (if (member name (map locale-definition-name + (operating-system-locale-definitions os))) + (operating-system-locale-definitions os) + (cons (locale-name->definition* name) + (operating-system-locale-definitions os)))) + + (locale-directory definitions #:libcs (operating-system-locale-libcs os))) (define (kernel->grub-label kernel) diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm index e798827a01..f9d713e0cf 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +33,7 @@ locale-definition-source locale-definition-charset + locale-name->definition locale-directory %default-locale-libcs @@ -52,6 +53,35 @@ (charset locale-definition-charset ;string--e.g., "UTF-8" (default "UTF-8"))) +(define %not-dot + (char-set-complement (char-set #\.))) + +(define (denormalize-codeset codeset) + "Attempt to guess the \"real\" name of CODESET, a normalized codeset as +defined in (info \"(libc) Using gettextized software\")." + (cond ((string=? codeset "utf8") + "UTF-8") + ((string-prefix? "iso8859" codeset) + (string-append "ISO-8859-" (string-drop codeset 7))) + ((string=? codeset "eucjp") + "EUC-JP") + (else ;cross fingers, hope for the best + codeset))) + +(define (locale-name->definition name) + "Return a <locale-definition> corresponding to NAME, guessing the charset, +or #f on failure." + (match (string-tokenize name %not-dot) + ((source charset) + ;; XXX: NAME is supposed to use the "normalized codeset", such as "utf8", + ;; whereas the actual name used is different. Add a special case to make + ;; the right guess for UTF-8. + (locale-definition (name name) + (source source) + (charset (denormalize-codeset charset)))) + (_ + #f))) + (define* (localedef-command locale #:key (libc (canonical-package glibc))) "Return a gexp that runs 'localedef' from LIBC to build LOCALE." |