gnu/installer/newt/locale.scm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer newt locale)
  #:use-module (gnu installer locale)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer newt page)
  #:use-module (guix i18n)
  #:use-module (newt)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:export (run-locale-page))

(define (run-language-page languages language->text)
  (define result
    (run-listbox-selection-page
     #:title (G_ "Locale language")
     #:info-text (G_ "Choose the language to use for the \
installation process and for the installed system.")
     #:info-textbox-width 70
     #:listbox-items languages
     #:listbox-item->text language->text
     #:sort-listbox-items? #f
     #:button-text (G_ "Exit")
     #:button-callback-procedure
     (lambda _
       (abort-to-prompt 'installer-step 'abort))))

  ;; Immediately install the chosen language so that the territory page that
  ;; comes after (optionally) is displayed in the chosen language.
  (setenv "LANGUAGE" result)

  result)

(define (run-territory-page territories territory->text)
  (let ((title (G_ "Locale location")))
    (run-listbox-selection-page
     #:title title
     #:info-text (G_ "Choose a territory for this language.")
     #:listbox-items territories
     #:listbox-item->text territory->text
     #:button-text (G_ "Back")
     #:button-callback-procedure
     (lambda _
       (abort-to-prompt 'installer-step 'abort)))))

(define (run-codeset-page codesets)
  (let ((title (G_ "Locale codeset")))
    (run-listbox-selection-page
     #:title title
     #:info-text (G_ "Choose the locale encoding.")
     #:listbox-items codesets
     #:listbox-item->text identity
     #:listbox-default-item "UTF-8"
     #:button-text (G_ "Back")
     #:button-callback-procedure
     (lambda _
       (abort-to-prompt 'installer-step 'abort)))))

(define (run-modifier-page modifiers modifier->text)
  (let ((title (G_ "Locale modifier")))
    (run-listbox-selection-page
     #:title title
     #:info-text (G_ "Choose your locale's modifier. The most frequent \
modifier is euro. It indicates that you want to use Euro as the currency \
symbol.")
     #:listbox-items modifiers
     #:listbox-item->text modifier->text
     #:button-text (G_ "Back")
     #:button-callback-procedure
     (lambda _
       (abort-to-prompt 'installer-step 'abort)))))

(define* (run-locale-page #:key
                          supported-locales
                          iso639-languages
                          iso3166-territories)
  "Run a page asking the user to select a locale language and possibly
territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
available locales. ISO639-LANGUAGES is an association list associating a
locale code to a locale name. ISO3166-TERRITORIES is an association list
associating a territory code with a territory name. The formatted locale, under
glibc format is returned."

  (define (break-on-locale-found locales)
    "Break to the installer step if LOCALES contains exactly one
element."
    (and (= (length locales) 1)
         (abort-to-prompt 'installer-step 'break)))

  (define (filter-locales locales result)
    "Filter the list of locale records LOCALES using the RESULT returned by
the installer-steps defined below."
    (filter
     (lambda (locale)
       (and-map identity
                `(,(string=? (locale-language locale)
                             (result-step result 'language))
                  ,@(if (result-step-done? result 'territory)
                        (list (equal? (locale-territory locale)
                                      (result-step result 'territory)))
                        '())
                  ,@(if (result-step-done? result 'codeset)
                        (list (equal? (locale-codeset locale)
                                      (result-step result 'codeset)))
                        '())
                  ,@(if (result-step-done? result 'modifier)
                        (list (equal? (locale-modifier locale)
                                      (result-step result 'modifier)))
                        '()))))
     locales))

  (define (result->locale-string locales result)
    "Supposing that LOCALES contains exactly one locale record, turn it into a
glibc locale string and return it."
    (match (filter-locales locales result)
      ((locale)
       (locale->locale-string locale))))

  (define (sort-languages languages)
    "Extract some languages from LANGUAGES list and place them ahead."
    (let* ((first-languages '("en"))
           (other-languages (lset-difference equal?
                                             languages
                                             first-languages)))
      `(,@first-languages ,@other-languages)))

  (define locale-steps
    (list
     (installer-step
      (id 'language)
      (compute
       (lambda _
         (run-language-page
          (sort-languages
           (delete-duplicates (map locale-language supported-locales)))
          (lambda (language)
            (let ((english (language-code->language-name iso639-languages
                                                         language)))
              (setenv "LANGUAGE" language)
              (let ((native (gettext english "iso_639-3")))
                (unsetenv "LANGUAGE")
                native)))))))
     (installer-step
      (id 'territory)
      (compute
       (lambda (result _)
         (let ((locales (filter-locales supported-locales result)))
           ;; Stop the process if the language returned by the previous step
           ;; is matching one and only one supported locale.
           (break-on-locale-found locales)

           ;; Otherwise, ask the user to select a territory among those
           ;; supported by the previously selected language.
           (run-territory-page
            (delete-duplicates (map locale-territory locales))
            (lambda (territory)
              (if territory
                  (let ((english (territory-code->territory-name
                                  iso3166-territories territory)))
                    (gettext english "iso_3166-1"))
                  (G_ "No location"))))))))
     (installer-step
      (id 'codeset)
      (compute
       (lambda (result _)
         (let ((locales (filter-locales supported-locales result)))
           ;; Same as above but we now have a language and a territory to
           ;; narrow down the search of a locale.
           (break-on-locale-found locales)

           ;; Otherwise, choose a codeset.
           (let ((codesets (delete-duplicates (map locale-codeset locales))))
             (if (member "UTF-8" codesets)
                 "UTF-8"                          ;don't even ask
                 (run-codeset-page codesets)))))))
     (installer-step
      (id 'modifier)
      (compute
       (lambda (result _)
         (let ((locales (filter-locales supported-locales result)))
           ;; Same thing with a language, a territory and a codeset this time.
           (break-on-locale-found locales)

           ;; Otherwise, ask for a modifier.
           (run-modifier-page
            (delete-duplicates (map locale-modifier locales))
            (lambda (modifier)
              (or modifier (G_ "No modifier"))))))))))

  ;; If run-installer-steps returns locally, it means that the user had to go
  ;; through all steps (language, territory, codeset and modifier) to select a
  ;; locale. In that case, like if we exited by breaking to the installer
  ;; step, turn the result into a glibc locale string and return it.
  (result->locale-string
   supported-locales
   (run-installer-steps #:steps locale-steps)))