226 lines
8.5 KiB
Scheme
226 lines
8.5 KiB
Scheme
;;; 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 _
|
|
(raise
|
|
(condition
|
|
(&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 _
|
|
(raise
|
|
(condition
|
|
(&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 _
|
|
(raise
|
|
(condition
|
|
(&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 _
|
|
(raise
|
|
(condition
|
|
(&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 formated locale, under
|
|
glibc format is returned."
|
|
|
|
(define (break-on-locale-found locales)
|
|
"Raise the &installer-step-break condition if LOCALES contains exactly one
|
|
element."
|
|
(and (= (length locales) 1)
|
|
(raise
|
|
(condition (&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 raising &installer-step-break
|
|
;; condition, turn the result into a glibc locale string and return it.
|
|
(result->locale-string
|
|
supported-locales
|
|
(run-installer-steps #:steps locale-steps)))
|