gnu/installer/newt/locale.scm

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