diff options
Diffstat (limited to 'gnu/installer/newt/locale.scm')
| -rw-r--r-- | gnu/installer/newt/locale.scm | 193 |
1 files changed, 193 insertions, 0 deletions
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm new file mode 100644 index 0000000000..5444a07598 --- /dev/null +++ b/gnu/installer/newt/locale.scm @@ -0,0 +1,193 @@ +;;; 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_ "Language selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose the language to be used for the installation \ +process. The selected language will also be the default \ +language for the installed system.") + #:listbox-items languages + #:listbox-item->text language->text + #:button-text (G_ "Cancel") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + +(define (run-territory-page territories territory->text) + (let ((title (G_ "Location selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your 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_ "Codeset selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your 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_ "Modifier selection"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose your modifier.") + #: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) + + (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 locale-steps + (list + (installer-step + (id 'language) + (compute + (lambda _ + (run-language-page + (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))) |