01/02: system: Selected locale is automatically built.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit f5582b2c1d7cb73f36d5278bec99d7279f813a39
Author: Ludovic Courtès <address@hidden>
Date:   Wed Feb 10 11:01:54 2016 +0100

    system: Selected locale is automatically built.
    
    Fixes <http://bugs.gnu.org/22572>.
    Reported by Mark H Weaver <address@hidden>.
    
    * gnu/system/locale.scm (%not-dot): New variable.
    (denormalize-codeset, locale-name->definition): New procedures.
    * gnu/system.scm (locale-name->definition*): New procedure.
    (operating-system-locale-directory): Instead of raising an error, add
    the missing locale.
    * doc/guix.texi (Locales): Adjust accordingly.
---
 doc/guix.texi         |   22 +++++++++++-----------
 gnu/system.scm        |   29 +++++++++++++++++++++--------
 gnu/system/locale.scm |   32 +++++++++++++++++++++++++++++++-
 3 files changed, 63 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 80a1621..bcb51c5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6452,17 +6452,17 @@ Usually, you will want to specify the default locale 
for the machine
 using the @code{locale} field of the @code{operating-system} declaration
 (@pxref{operating-system Reference, @code{locale}}).
 
-That locale must be among the @dfn{locale definitions} that are known to
-the system---and these are specified in the @code{locale-definitions}
-slot of @code{operating-system}.  The default value includes locale
-definitions for some widely used locales, but not for all the available
-locales, in order to save space.
-
-If the locale specified in the @code{locale} field is not among the
-definitions listed in @code{locale-definitions}, @command{guix system}
-raises an error.  In that case, you should add the locale definition to
-the @code{locale-definitions} field.  For instance, to add the North
-Frisian locale for Germany, the value of that field may be:
+The selected locale is automatically added to the @dfn{locale
+definitions} known to the system if needed, with its codeset inferred
+from its name---e.g., @code{bo_CN.utf8} will be assumed to use the
address@hidden codeset.  Additional locale definitions can be specified in
+the @code{locale-definitions} slot of @code{operating-system}---this is
+useful, for instance, if the codeset could not be inferred from the
+locale name.  The default set of locale definitions includes some widely
+used locales, but not all the available locales, in order to save space.
+
+For instance, to add the North Frisian locale for Germany, the value of
+that field may be:
 
 @example
 (cons (locale-definition
diff --git a/gnu/system.scm b/gnu/system.scm
index 9540324..b9d717d 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 e798827..f9d713e 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 <address@hidden>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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."