Commit | Line | Data |
---|---|---|
d0f3a672 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |
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 installer newt locale) | |
20 | #:use-module (gnu installer locale) | |
21 | #:use-module (gnu installer steps) | |
22 | #:use-module (gnu installer newt page) | |
23 | #:use-module (guix i18n) | |
24 | #:use-module (newt) | |
25 | #:use-module (srfi srfi-1) | |
26 | #:use-module (srfi srfi-26) | |
27 | #:use-module (srfi srfi-34) | |
28 | #:use-module (srfi srfi-35) | |
29 | #:use-module (ice-9 match) | |
30 | #:export (run-locale-page)) | |
31 | ||
32 | (define (run-language-page languages language->text) | |
30b4df86 | 33 | (let ((title (G_ "Locale language"))) |
d0f3a672 MO |
34 | (run-listbox-selection-page |
35 | #:title title | |
04d0aa99 LC |
36 | #:info-text (G_ "Choose the language to use for the \ |
37 | installation process and for the installed system.") | |
30b4df86 | 38 | #:info-textbox-width 70 |
d0f3a672 MO |
39 | #:listbox-items languages |
40 | #:listbox-item->text language->text | |
30b4df86 | 41 | #:sort-listbox-items? #f |
7d812901 | 42 | #:button-text (G_ "Exit") |
d0f3a672 MO |
43 | #:button-callback-procedure |
44 | (lambda _ | |
45 | (raise | |
46 | (condition | |
47 | (&installer-step-abort))))))) | |
48 | ||
49 | (define (run-territory-page territories territory->text) | |
30b4df86 | 50 | (let ((title (G_ "Locale location"))) |
d0f3a672 MO |
51 | (run-listbox-selection-page |
52 | #:title title | |
04d0aa99 | 53 | #:info-text (G_ "Choose a territory for this language.") |
d0f3a672 MO |
54 | #:listbox-items territories |
55 | #:listbox-item->text territory->text | |
56 | #:button-text (G_ "Back") | |
57 | #:button-callback-procedure | |
58 | (lambda _ | |
59 | (raise | |
60 | (condition | |
61 | (&installer-step-abort))))))) | |
62 | ||
63 | (define (run-codeset-page codesets) | |
30b4df86 | 64 | (let ((title (G_ "Locale codeset"))) |
d0f3a672 MO |
65 | (run-listbox-selection-page |
66 | #:title title | |
04d0aa99 | 67 | #:info-text (G_ "Choose the locale encoding.") |
d0f3a672 MO |
68 | #:listbox-items codesets |
69 | #:listbox-item->text identity | |
70 | #:listbox-default-item "UTF-8" | |
71 | #:button-text (G_ "Back") | |
72 | #:button-callback-procedure | |
73 | (lambda _ | |
74 | (raise | |
75 | (condition | |
76 | (&installer-step-abort))))))) | |
77 | ||
78 | (define (run-modifier-page modifiers modifier->text) | |
30b4df86 | 79 | (let ((title (G_ "Locale modifier"))) |
d0f3a672 MO |
80 | (run-listbox-selection-page |
81 | #:title title | |
30b4df86 MO |
82 | #:info-text (G_ "Choose your locale's modifier. The most frequent \ |
83 | modifier is euro. It indicates that you want to use Euro as the currency \ | |
84 | symbol.") | |
d0f3a672 MO |
85 | #:listbox-items modifiers |
86 | #:listbox-item->text modifier->text | |
87 | #:button-text (G_ "Back") | |
88 | #:button-callback-procedure | |
89 | (lambda _ | |
90 | (raise | |
91 | (condition | |
92 | (&installer-step-abort))))))) | |
93 | ||
94 | (define* (run-locale-page #:key | |
95 | supported-locales | |
96 | iso639-languages | |
97 | iso3166-territories) | |
30b4df86 MO |
98 | "Run a page asking the user to select a locale language and possibly |
99 | territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc | |
100 | available locales. ISO639-LANGUAGES is an association list associating a | |
101 | locale code to a locale name. ISO3166-TERRITORIES is an association list | |
102 | associating a territory code with a territory name. The formated locale, under | |
103 | glibc format is returned." | |
d0f3a672 MO |
104 | |
105 | (define (break-on-locale-found locales) | |
106 | "Raise the &installer-step-break condition if LOCALES contains exactly one | |
107 | element." | |
108 | (and (= (length locales) 1) | |
109 | (raise | |
110 | (condition (&installer-step-break))))) | |
111 | ||
112 | (define (filter-locales locales result) | |
113 | "Filter the list of locale records LOCALES using the RESULT returned by | |
114 | the installer-steps defined below." | |
115 | (filter | |
116 | (lambda (locale) | |
117 | (and-map identity | |
118 | `(,(string=? (locale-language locale) | |
119 | (result-step result 'language)) | |
120 | ,@(if (result-step-done? result 'territory) | |
121 | (list (equal? (locale-territory locale) | |
122 | (result-step result 'territory))) | |
123 | '()) | |
124 | ,@(if (result-step-done? result 'codeset) | |
125 | (list (equal? (locale-codeset locale) | |
126 | (result-step result 'codeset))) | |
127 | '()) | |
128 | ,@(if (result-step-done? result 'modifier) | |
129 | (list (equal? (locale-modifier locale) | |
130 | (result-step result 'modifier))) | |
131 | '())))) | |
132 | locales)) | |
133 | ||
134 | (define (result->locale-string locales result) | |
135 | "Supposing that LOCALES contains exactly one locale record, turn it into a | |
136 | glibc locale string and return it." | |
137 | (match (filter-locales locales result) | |
138 | ((locale) | |
139 | (locale->locale-string locale)))) | |
140 | ||
30cf5e04 MO |
141 | (define (sort-languages languages) |
142 | "Extract some languages from LANGUAGES list and place them ahead." | |
143 | (let* ((first-languages '("en")) | |
144 | (other-languages (lset-difference equal? | |
145 | languages | |
146 | first-languages))) | |
147 | `(,@first-languages ,@other-languages))) | |
148 | ||
d0f3a672 MO |
149 | (define locale-steps |
150 | (list | |
151 | (installer-step | |
152 | (id 'language) | |
153 | (compute | |
154 | (lambda _ | |
155 | (run-language-page | |
30cf5e04 MO |
156 | (sort-languages |
157 | (delete-duplicates (map locale-language supported-locales))) | |
d0f3a672 MO |
158 | (cut language-code->language-name iso639-languages <>))))) |
159 | (installer-step | |
160 | (id 'territory) | |
161 | (compute | |
c088b2e4 | 162 | (lambda (result _) |
d0f3a672 MO |
163 | (let ((locales (filter-locales supported-locales result))) |
164 | ;; Stop the process if the language returned by the previous step | |
165 | ;; is matching one and only one supported locale. | |
166 | (break-on-locale-found locales) | |
167 | ||
168 | ;; Otherwise, ask the user to select a territory among those | |
169 | ;; supported by the previously selected language. | |
170 | (run-territory-page | |
171 | (delete-duplicates (map locale-territory locales)) | |
172 | (lambda (territory-code) | |
173 | (if territory-code | |
174 | (territory-code->territory-name iso3166-territories | |
175 | territory-code) | |
176 | (G_ "No location")))))))) | |
177 | (installer-step | |
178 | (id 'codeset) | |
179 | (compute | |
c088b2e4 | 180 | (lambda (result _) |
d0f3a672 MO |
181 | (let ((locales (filter-locales supported-locales result))) |
182 | ;; Same as above but we now have a language and a territory to | |
183 | ;; narrow down the search of a locale. | |
184 | (break-on-locale-found locales) | |
185 | ||
04d0aa99 LC |
186 | ;; Otherwise, choose a codeset. |
187 | (let ((codesets (delete-duplicates (map locale-codeset locales)))) | |
188 | (if (member "UTF-8" codesets) | |
189 | "UTF-8" ;don't even ask | |
190 | (run-codeset-page codesets))))))) | |
d0f3a672 MO |
191 | (installer-step |
192 | (id 'modifier) | |
193 | (compute | |
c088b2e4 | 194 | (lambda (result _) |
d0f3a672 MO |
195 | (let ((locales (filter-locales supported-locales result))) |
196 | ;; Same thing with a language, a territory and a codeset this time. | |
197 | (break-on-locale-found locales) | |
198 | ||
199 | ;; Otherwise, ask for a modifier. | |
200 | (run-modifier-page | |
201 | (delete-duplicates (map locale-modifier locales)) | |
202 | (lambda (modifier) | |
203 | (or modifier (G_ "No modifier")))))))))) | |
204 | ||
205 | ;; If run-installer-steps returns locally, it means that the user had to go | |
206 | ;; through all steps (language, territory, codeset and modifier) to select a | |
207 | ;; locale. In that case, like if we exited by raising &installer-step-break | |
208 | ;; condition, turn the result into a glibc locale string and return it. | |
209 | (result->locale-string | |
210 | supported-locales | |
211 | (run-installer-steps #:steps locale-steps))) |