diff options
Diffstat (limited to 'gnu/installer/newt/locale.scm')
| -rw-r--r-- | gnu/installer/newt/locale.scm | 217 |
1 files changed, 217 insertions, 0 deletions
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm new file mode 100644 index 0000000000..4fa07df81e --- /dev/null +++ b/gnu/installer/newt/locale.scm @@ -0,0 +1,217 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; +;;; 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) + (let ((title (G_ "Locale language"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose the locale's language to be used for the \ +installation process. A locale is a regional variant of your language \ +encompassing number, date and currency format, among other details. + +Based on the language you choose, you will possibly be asked to \ +select a locale's territory, codeset and modifier in the next \ +steps. The locale will also be used as the default one 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))))))) + +(define (run-territory-page territories territory->text) + (let ((title (G_ "Locale location"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your locale's location. This is a shortlist of \ +locations based on the language you selected.") + #: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 your locale's codeset. If UTF-8 is available, \ + it should be preferred.") + #: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))) + (cut language-code->language-name iso639-languages <>))))) + (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-code) + (if territory-code + (territory-code->territory-name iso3166-territories + territory-code) + (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, ask for a codeset. + (run-codeset-page + (delete-duplicates (map locale-codeset locales))))))) + (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))) |