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