Commit | Line | Data |
---|---|---|
598e19dc | 1 | ;;; GNU Guix --- Functional package management for GNU |
4ddb64f5 | 2 | ;;; Copyright © 2014, 2015, 2016, 2017 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) |
598e19dc | 23 | #:use-module (guix records) |
46bd6edd | 24 | #:use-module (guix packages) |
6d5a65de | 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." |
598e19dc LC |
88 | #~(begin |
89 | (format #t "building locale '~a'...~%" | |
90 | #$(locale-definition-name locale)) | |
4ddb64f5 | 91 | (zero? (system* (string-append #+libc "/bin/localedef") |
598e19dc LC |
92 | "--no-archive" "--prefix" #$output |
93 | "-i" #$(locale-definition-source locale) | |
94 | "-f" #$(locale-definition-charset locale) | |
6d5a65de MW |
95 | (string-append #$output "/" #$(version-major+minor |
96 | (package-version libc)) | |
97 | "/" #$(locale-definition-name locale)))))) | |
598e19dc | 98 | |
34760ae7 LC |
99 | (define* (single-locale-directory locales |
100 | #:key (libc (canonical-package glibc))) | |
46bd6edd LC |
101 | "Return a directory containing all of LOCALES for LIBC compiled. |
102 | ||
103 | Because locale data formats are incompatible when switching from one libc to | |
104 | another, locale data is put in a sub-directory named after the 'version' field | |
105 | of LIBC." | |
34760ae7 | 106 | (define version |
6d5a65de | 107 | (version-major+minor (package-version libc))) |
34760ae7 | 108 | |
598e19dc LC |
109 | (define build |
110 | #~(begin | |
111 | (mkdir #$output) | |
34760ae7 | 112 | |
6d833b13 | 113 | (mkdir (string-append #$output "/" #$version)) |
598e19dc LC |
114 | |
115 | ;; 'localedef' executes 'gzip' to access compressed locale sources. | |
116 | (setenv "PATH" (string-append #$gzip "/bin")) | |
117 | ||
118 | (exit | |
119 | (and #$@(map (cut localedef-command <> #:libc libc) | |
120 | locales))))) | |
121 | ||
b19a49d0 | 122 | (computed-file (string-append "locale-" version) build)) |
598e19dc | 123 | |
34760ae7 LC |
124 | (define* (locale-directory locales |
125 | #:key (libcs %default-locale-libcs)) | |
126 | "Return a locale directory containing all of LOCALES for each libc package | |
127 | listed in LIBCS. | |
128 | ||
129 | It is useful to list more than one libc when willing to support | |
130 | already-installed packages built against a different libc since the locale | |
131 | data format changes between libc versions." | |
132 | (match libcs | |
133 | ((libc) | |
134 | (single-locale-directory locales #:libc libc)) | |
135 | ((libcs ..1) | |
b19a49d0 LC |
136 | (let ((dirs (map (lambda (libc) |
137 | (single-locale-directory locales #:libc libc)) | |
138 | libcs))) | |
139 | (computed-file "locale-multiple-versions" | |
140 | (with-imported-modules '((guix build union)) | |
141 | #~(begin | |
142 | (use-modules (guix build union)) | |
143 | (union-build #$output (list #$@dirs)))) | |
144 | #:options '(#:local-build? #t | |
145 | #:substitutable? #f)))))) | |
34760ae7 LC |
146 | |
147 | (define %default-locale-libcs | |
148 | ;; The libcs for which we build locales by default. | |
149 | (list (canonical-package glibc))) | |
150 | ||
598e19dc LC |
151 | (define %default-locale-definitions |
152 | ;; Arbitrary set of locales that are built by default. They are here mostly | |
153 | ;; to facilitate first-time use to some people, while others may have to add | |
154 | ;; a specific <locale-definition>. | |
155 | (letrec-syntax ((utf8-locale (syntax-rules () | |
156 | ((_ name*) | |
157 | (locale-definition | |
b2636518 LC |
158 | ;; Note: We choose "utf8", which is the |
159 | ;; "normalized codeset". | |
598e19dc LC |
160 | (name (string-append name* ".utf8")) |
161 | (source name*) | |
162 | (charset "UTF-8"))))) | |
163 | (utf8-locales (syntax-rules () | |
164 | ((_ name ...) | |
165 | (list (utf8-locale name) ...))))) | |
24004073 LC |
166 | ;; Add "en_US.UTF-8" for compatibility with Guix 0.8. |
167 | (cons (locale-definition | |
168 | (name "en_US.UTF-8") | |
169 | (source "en_US") | |
170 | (charset "UTF-8")) | |
171 | (utf8-locales "ca_ES" | |
172 | "cs_CZ" | |
173 | "da_DK" | |
174 | "de_DE" | |
175 | "el_GR" | |
176 | "en_AU" | |
177 | "en_CA" | |
178 | "en_GB" | |
179 | "en_US" | |
180 | "es_AR" | |
181 | "es_CL" | |
182 | "es_ES" | |
183 | "es_MX" | |
184 | "fi_FI" | |
185 | "fr_BE" | |
186 | "fr_CA" | |
187 | "fr_CH" | |
188 | "fr_FR" | |
189 | "ga_IE" | |
190 | "it_IT" | |
191 | "ja_JP" | |
192 | "ko_KR" | |
193 | "nb_NO" | |
194 | "nl_NL" | |
195 | "pl_PL" | |
196 | "pt_PT" | |
197 | "ro_RO" | |
198 | "ru_RU" | |
199 | "sv_SE" | |
200 | "tr_TR" | |
201 | "uk_UA" | |
202 | "vi_VN" | |
203 | "zh_CN")))) | |
598e19dc LC |
204 | |
205 | ;;; locale.scm ends here |