gnu/system/locale.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu system locale)
  20   #:use-module (guix gexp)
  21   #:use-module (guix store)
  22   #:use-module (guix records)
  23   #:use-module (guix packages)
  24   #:use-module (gnu packages base)
  25   #:use-module (gnu packages compression)
  26   #:use-module (srfi srfi-26)
  27   #:use-module (ice-9 match)
  28   #:export (locale-definition
  29             locale-definition?
  30             locale-definition-name
  31             locale-definition-source
  32             locale-definition-charset
  33
  34             locale-name->definition
  35             locale-directory
  36
  37             %default-locale-libcs
  38             %default-locale-definitions))
  39
  40 ;;; Commentary:
  41 ;;;
  42 ;;; Locale definitions, and compilation thereof.
  43 ;;;
  44 ;;; Code:
  45
  46 (define-record-type* <locale-definition> locale-definition
  47   make-locale-definition
  48   locale-definition?
  49   (name    locale-definition-name)                ;string--e.g., "fr_FR.utf8"
  50   (source  locale-definition-source)              ;string--e.g., "fr_FR"
  51   (charset locale-definition-charset              ;string--e.g., "UTF-8"
  52            (default "UTF-8")))
  53
  54 (define %not-dot
  55   (char-set-complement (char-set #\.)))
  56
  57 (define (denormalize-codeset codeset)
  58   "Attempt to guess the \"real\" name of CODESET, a normalized codeset as
  59 defined in (info \"(libc) Using gettextized software\")."
  60   (cond ((string=? codeset "utf8")
  61          "UTF-8")
  62         ((string-prefix? "iso8859" codeset)
  63          (string-append "ISO-8859-" (string-drop codeset 7)))
  64         ((string=? codeset "eucjp")
  65          "EUC-JP")
  66         (else                                ;cross fingers, hope for the best
  67          codeset)))
  68
  69 (define (locale-name->definition name)
  70   "Return a <locale-definition> corresponding to NAME, guessing the charset,
  71 or #f on failure."
  72   (match (string-tokenize name %not-dot)
  73     ((source charset)
  74      ;; XXX: NAME is supposed to use the "normalized codeset", such as "utf8",
  75      ;; whereas the actual name used is different.  Add a special case to make
  76      ;; the right guess for UTF-8.
  77      (locale-definition (name name)
  78                         (source source)
  79                         (charset (denormalize-codeset charset))))
  80     (_
  81      #f)))
  82
  83 (define* (localedef-command locale
  84                             #:key (libc (canonical-package glibc)))
  85   "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
  86   #~(begin
  87       (format #t "building locale '~a'...~%"
  88               #$(locale-definition-name locale))
  89       (zero? (system* (string-append #+libc "/bin/localedef")
  90                       "--no-archive" "--prefix" #$output
  91                       "-i" #$(locale-definition-source locale)
  92                       "-f" #$(locale-definition-charset locale)
  93                       (string-append #$output "/"
  94                                      #$(package-version libc) "/"
  95                                      #$(locale-definition-name locale))))))
  96
  97 (define* (single-locale-directory locales
  98                                   #:key (libc (canonical-package glibc)))
  99   "Return a directory containing all of LOCALES for LIBC compiled.
 100
 101 Because locale data formats are incompatible when switching from one libc to
 102 another, locale data is put in a sub-directory named after the 'version' field
 103 of LIBC."
 104   (define version
 105     (package-version libc))
 106
 107   (define build
 108     #~(begin
 109         (mkdir #$output)
 110
 111         (mkdir (string-append #$output "/" #$version))
 112
 113         ;; 'localedef' executes 'gzip' to access compressed locale sources.
 114         (setenv "PATH" (string-append #$gzip "/bin"))
 115
 116         (exit
 117          (and #$@(map (cut localedef-command <> #:libc libc)
 118                       locales)))))
 119
 120   (computed-file (string-append "locale-" version) build))
 121
 122 (define* (locale-directory locales
 123                            #:key (libcs %default-locale-libcs))
 124   "Return a locale directory containing all of LOCALES for each libc package
 125 listed in LIBCS.
 126
 127 It is useful to list more than one libc when willing to support
 128 already-installed packages built against a different libc since the locale
 129 data format changes between libc versions."
 130   (match libcs
 131     ((libc)
 132      (single-locale-directory locales #:libc libc))
 133     ((libcs ..1)
 134      (let ((dirs (map (lambda (libc)
 135                         (single-locale-directory locales #:libc libc))
 136                       libcs)))
 137        (computed-file "locale-multiple-versions"
 138                       (with-imported-modules '((guix build union))
 139                         #~(begin
 140                             (use-modules (guix build union))
 141                             (union-build #$output (list #$@dirs))))
 142                       #:options '(#:local-build? #t
 143                                   #:substitutable? #f))))))
 144
 145 (define %default-locale-libcs
 146   ;; The libcs for which we build locales by default.
 147   (list (canonical-package glibc)))
 148
 149 (define %default-locale-definitions
 150   ;; Arbitrary set of locales that are built by default.  They are here mostly
 151   ;; to facilitate first-time use to some people, while others may have to add
 152   ;; a specific <locale-definition>.
 153   (letrec-syntax ((utf8-locale (syntax-rules ()
 154                                  ((_ name*)
 155                                   (locale-definition
 156                                    ;; Note: We choose "utf8", which is the
 157                                    ;; "normalized codeset".
 158                                    (name (string-append name* ".utf8"))
 159                                    (source name*)
 160                                    (charset "UTF-8")))))
 161                   (utf8-locales (syntax-rules ()
 162                                   ((_ name ...)
 163                                    (list (utf8-locale name) ...)))))
 164     ;; Add "en_US.UTF-8" for compatibility with Guix 0.8.
 165     (cons (locale-definition
 166            (name "en_US.UTF-8")
 167            (source "en_US")
 168            (charset "UTF-8"))
 169           (utf8-locales "ca_ES"
 170                         "cs_CZ"
 171                         "da_DK"
 172                         "de_DE"
 173                         "el_GR"
 174                         "en_AU"
 175                         "en_CA"
 176                         "en_GB"
 177                         "en_US"
 178                         "es_AR"
 179                         "es_CL"
 180                         "es_ES"
 181                         "es_MX"
 182                         "fi_FI"
 183                         "fr_BE"
 184                         "fr_CA"
 185                         "fr_CH"
 186                         "fr_FR"
 187                         "ga_IE"
 188                         "it_IT"
 189                         "ja_JP"
 190                         "ko_KR"
 191                         "nb_NO"
 192                         "nl_NL"
 193                         "pl_PL"
 194                         "pt_PT"
 195                         "ro_RO"
 196                         "ru_RU"
 197                         "sv_SE"
 198                         "tr_TR"
 199                         "uk_UA"
 200                         "vi_VN"
 201                         "zh_CN"))))
 202
 203 ;;; locale.scm ends here