Commit | Line | Data |
---|---|---|
598e19dc | 1 | ;;; GNU Guix --- Functional package management for GNU |
f5582b2c | 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
598e19dc LC |
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) | |
34760ae7 LC |
21 | #:use-module (guix store) |
22 | #:use-module (guix monads) | |
598e19dc | 23 | #:use-module (guix records) |
46bd6edd | 24 | #:use-module (guix packages) |
34760ae7 | 25 | #:use-module (guix utils) |
598e19dc LC |
26 | #:use-module (gnu packages base) |
27 | #:use-module (gnu packages compression) | |
28 | #:use-module (srfi srfi-26) | |
34760ae7 | 29 | #:use-module (ice-9 match) |
598e19dc LC |
30 | #:export (locale-definition |
31 | locale-definition? | |
32 | locale-definition-name | |
33 | locale-definition-source | |
34 | locale-definition-charset | |
35 | ||
f5582b2c | 36 | locale-name->definition |
598e19dc LC |
37 | locale-directory |
38 | ||
34760ae7 | 39 | %default-locale-libcs |
598e19dc LC |
40 | %default-locale-definitions)) |
41 | ||
42 | ;;; Commentary: | |
43 | ;;; | |
44 | ;;; Locale definitions, and compilation thereof. | |
45 | ;;; | |
46 | ;;; Code: | |
47 | ||
48 | (define-record-type* <locale-definition> locale-definition | |
49 | make-locale-definition | |
50 | locale-definition? | |
51 | (name locale-definition-name) ;string--e.g., "fr_FR.utf8" | |
52 | (source locale-definition-source) ;string--e.g., "fr_FR" | |
53 | (charset locale-definition-charset ;string--e.g., "UTF-8" | |
54 | (default "UTF-8"))) | |
55 | ||
f5582b2c LC |
56 | (define %not-dot |
57 | (char-set-complement (char-set #\.))) | |
58 | ||
59 | (define (denormalize-codeset codeset) | |
60 | "Attempt to guess the \"real\" name of CODESET, a normalized codeset as | |
61 | defined in (info \"(libc) Using gettextized software\")." | |
62 | (cond ((string=? codeset "utf8") | |
63 | "UTF-8") | |
64 | ((string-prefix? "iso8859" codeset) | |
65 | (string-append "ISO-8859-" (string-drop codeset 7))) | |
66 | ((string=? codeset "eucjp") | |
67 | "EUC-JP") | |
68 | (else ;cross fingers, hope for the best | |
69 | codeset))) | |
70 | ||
71 | (define (locale-name->definition name) | |
72 | "Return a <locale-definition> corresponding to NAME, guessing the charset, | |
73 | or #f on failure." | |
74 | (match (string-tokenize name %not-dot) | |
75 | ((source charset) | |
76 | ;; XXX: NAME is supposed to use the "normalized codeset", such as "utf8", | |
77 | ;; whereas the actual name used is different. Add a special case to make | |
78 | ;; the right guess for UTF-8. | |
79 | (locale-definition (name name) | |
80 | (source source) | |
81 | (charset (denormalize-codeset charset)))) | |
82 | (_ | |
83 | #f))) | |
84 | ||
598e19dc LC |
85 | (define* (localedef-command locale |
86 | #:key (libc (canonical-package glibc))) | |
1cc8f3a6 | 87 | "Return a gexp that runs 'localedef' from LIBC to build LOCALE." |
34760ae7 LC |
88 | (define (maybe-version-directory) |
89 | ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a | |
90 | ;; version-specific sub-directory. Check whether this is the case. | |
91 | ;; TODO: Remove this hack once libc 2.21 is buried. | |
92 | (let ((version (package-version libc))) | |
93 | (if (version>=? version "2.22") | |
94 | (list version "/") | |
95 | '()))) | |
96 | ||
598e19dc LC |
97 | #~(begin |
98 | (format #t "building locale '~a'...~%" | |
99 | #$(locale-definition-name locale)) | |
100 | (zero? (system* (string-append #$libc "/bin/localedef") | |
101 | "--no-archive" "--prefix" #$output | |
102 | "-i" #$(locale-definition-source locale) | |
103 | "-f" #$(locale-definition-charset locale) | |
104 | (string-append #$output "/" | |
34760ae7 | 105 | #$@(maybe-version-directory) |
598e19dc LC |
106 | #$(locale-definition-name locale)))))) |
107 | ||
34760ae7 LC |
108 | (define* (single-locale-directory locales |
109 | #:key (libc (canonical-package glibc))) | |
46bd6edd LC |
110 | "Return a directory containing all of LOCALES for LIBC compiled. |
111 | ||
112 | Because locale data formats are incompatible when switching from one libc to | |
113 | another, locale data is put in a sub-directory named after the 'version' field | |
114 | of LIBC." | |
34760ae7 LC |
115 | (define version |
116 | (package-version libc)) | |
117 | ||
598e19dc LC |
118 | (define build |
119 | #~(begin | |
120 | (mkdir #$output) | |
34760ae7 LC |
121 | |
122 | ;; XXX: For libcs < 2.22, locale data is stored in the top-level | |
123 | ;; directory. | |
124 | ;; TODO: Remove this hack once libc 2.21 is buried. | |
125 | #$(if (version>=? version "2.22") | |
126 | #~(mkdir (string-append #$output "/" #$version)) | |
127 | #~(symlink "." (string-append #$output "/" #$version))) | |
598e19dc LC |
128 | |
129 | ;; 'localedef' executes 'gzip' to access compressed locale sources. | |
130 | (setenv "PATH" (string-append #$gzip "/bin")) | |
131 | ||
132 | (exit | |
133 | (and #$@(map (cut localedef-command <> #:libc libc) | |
134 | locales))))) | |
135 | ||
34760ae7 | 136 | (gexp->derivation (string-append "locale-" version) build |
598e19dc LC |
137 | #:local-build? #t)) |
138 | ||
34760ae7 LC |
139 | (define* (locale-directory locales |
140 | #:key (libcs %default-locale-libcs)) | |
141 | "Return a locale directory containing all of LOCALES for each libc package | |
142 | listed in LIBCS. | |
143 | ||
144 | It is useful to list more than one libc when willing to support | |
145 | already-installed packages built against a different libc since the locale | |
146 | data format changes between libc versions." | |
147 | (match libcs | |
148 | ((libc) | |
149 | (single-locale-directory locales #:libc libc)) | |
150 | ((libcs ..1) | |
151 | (mlet %store-monad ((dirs (mapm %store-monad | |
152 | (lambda (libc) | |
153 | (single-locale-directory locales | |
154 | #:libc libc)) | |
155 | libcs))) | |
156 | (gexp->derivation "locale-multiple-versions" | |
4ee96a79 LC |
157 | (with-imported-modules '((guix build union)) |
158 | #~(begin | |
159 | (use-modules (guix build union)) | |
160 | (union-build #$output (list #$@dirs)))) | |
34760ae7 LC |
161 | #:local-build? #t |
162 | #:substitutable? #f))))) | |
163 | ||
164 | (define %default-locale-libcs | |
165 | ;; The libcs for which we build locales by default. | |
166 | (list (canonical-package glibc))) | |
167 | ||
598e19dc LC |
168 | (define %default-locale-definitions |
169 | ;; Arbitrary set of locales that are built by default. They are here mostly | |
170 | ;; to facilitate first-time use to some people, while others may have to add | |
171 | ;; a specific <locale-definition>. | |
172 | (letrec-syntax ((utf8-locale (syntax-rules () | |
173 | ((_ name*) | |
174 | (locale-definition | |
b2636518 LC |
175 | ;; Note: We choose "utf8", which is the |
176 | ;; "normalized codeset". | |
598e19dc LC |
177 | (name (string-append name* ".utf8")) |
178 | (source name*) | |
179 | (charset "UTF-8"))))) | |
180 | (utf8-locales (syntax-rules () | |
181 | ((_ name ...) | |
182 | (list (utf8-locale name) ...))))) | |
24004073 LC |
183 | ;; Add "en_US.UTF-8" for compatibility with Guix 0.8. |
184 | (cons (locale-definition | |
185 | (name "en_US.UTF-8") | |
186 | (source "en_US") | |
187 | (charset "UTF-8")) | |
188 | (utf8-locales "ca_ES" | |
189 | "cs_CZ" | |
190 | "da_DK" | |
191 | "de_DE" | |
192 | "el_GR" | |
193 | "en_AU" | |
194 | "en_CA" | |
195 | "en_GB" | |
196 | "en_US" | |
197 | "es_AR" | |
198 | "es_CL" | |
199 | "es_ES" | |
200 | "es_MX" | |
201 | "fi_FI" | |
202 | "fr_BE" | |
203 | "fr_CA" | |
204 | "fr_CH" | |
205 | "fr_FR" | |
206 | "ga_IE" | |
207 | "it_IT" | |
208 | "ja_JP" | |
209 | "ko_KR" | |
210 | "nb_NO" | |
211 | "nl_NL" | |
212 | "pl_PL" | |
213 | "pt_PT" | |
214 | "ro_RO" | |
215 | "ru_RU" | |
216 | "sv_SE" | |
217 | "tr_TR" | |
218 | "uk_UA" | |
219 | "vi_VN" | |
220 | "zh_CN")))) | |
598e19dc LC |
221 | |
222 | ;;; locale.scm ends here |